I have stucked in a working and want to solution from VBA codes.
I have a file have 2 sheets.One is 'Current' and other is 'Previous'.Want to automate create a 'Summary' sheet who reveals the individual parts in both the sheets also other datas.Means,if any part is appearing in both sheets,which is common,that should not be include in summary sheet.I have tried my best to explain the same in column K in my attach sheet.
Can it be posible through Macro ?
Construct a report from 2 sheets have individual parts
-
- 3StarLounger
- Posts: 354
- Joined: 27 Oct 2013, 15:11
- Location: Gurgaon INDIA
Construct a report from 2 sheets have individual parts
Regards
Pradeep Kumar Gupta
INDIA
Pradeep Kumar Gupta
INDIA
-
- Administrator
- Posts: 78647
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Construct a report from 2 sheets have individual parts
Should we look at the Part Code column?
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 354
- Joined: 27 Oct 2013, 15:11
- Location: Gurgaon INDIA
Re: Construct a report from 2 sheets have individual parts
Yes sir.Look up the part code first and according to its rest of datas.
Regards
Pradeep Kumar Gupta
INDIA
Pradeep Kumar Gupta
INDIA
-
- Administrator
- Posts: 78647
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Construct a report from 2 sheets have individual parts
Here is a first version:
Code: Select all
Sub CreateList()
' First data row
Const FirstRow = 6
Dim wshC As Worksheet
Dim wshP As Worksheet
Dim wshS As Worksheet
Dim rngC As Range
Dim celC As Range
Dim rngP As Range
Dim celP As Range
Dim LastRow As Long
Dim lngRow As Long
Application.ScreenUpdating = False
lngRow = FirstRow
' Set references to worksheets
Set wshC = Worksheets("Current")
Set wshP = Worksheets("Previous")
Set wshS = Worksheets("Summary")
' Clear existing data from Summary sheet
wshS.Range("A" & FirstRow & ":K" & wshS.Rows.Count).ClearContents
' Used range in column B on Current sheet
LastRow = wshC.Range("B" & wshC.Rows.Count).End(xlUp).Row
Set rngC = wshC.Range("B" & FirstRow & ":B" & LastRow)
' Used range in column B on Previous sheet
LastRow = wshP.Range("B" & wshP.Rows.Count).End(xlUp).Row
Set rngP = wshP.Range("B" & FirstRow & ":B" & LastRow)
' Loop through rows on Current sheet
For Each celC In rngC
If celC.Value <> "" Then
' Try to find value on Previous sheet
Set celP = rngP.Find(What:=celC.Value, LookAt:=xlWhole)
If celP Is Nothing Then
lngRow = lngRow + 1
wshS.Range("B" & lngRow & ":E" & lngRow).Value = _
celC.Resize(ColumnSize:=4).Value
wshS.Range("G" & lngRow).Value = celC.Offset(ColumnOffset:=4).Value
wshS.Range("I" & lngRow).Value = celC.Offset(ColumnOffset:=5).Value
wshS.Range("K" & lngRow).Value = "Does not appear in Previous sheet"
End If
End If
Next celC
' Loop through rows on Previous sheet
For Each celP In rngP
If celP.Value <> "" Then
' Try to find value on Current sheet
Set celC = rngC.Find(What:=celP.Value, LookAt:=xlWhole)
If celC Is Nothing Then
lngRow = lngRow + 1
wshS.Range("B" & lngRow & ":D" & lngRow).Value = _
celP.Resize(ColumnSize:=3).Value
wshS.Range("F" & lngRow).Value = celP.Offset(ColumnOffset:=3).Value
wshS.Range("H" & lngRow).Value = celP.Offset(ColumnOffset:=4).Value
wshS.Range("J" & lngRow).Value = celP.Offset(ColumnOffset:=5).Value
wshS.Range("K" & lngRow).Value = "Does not appear in Current sheet"
End If
End If
Next celP
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 354
- Joined: 27 Oct 2013, 15:11
- Location: Gurgaon INDIA
Re: Construct a report from 2 sheets have individual parts
Macro is working perfect but only one problem.The problem is one part code should not repeat twice or more.It should be only appear as once and sum up the Qty and amount of these type of parts.
Please refer my attach file as 'revised parts'.In this file,the result of row no.13 to 16 should be as row no.28 and 29.
Rate formula=Amount/Qty
Please refer my attach file as 'revised parts'.In this file,the result of row no.13 to 16 should be as row no.28 and 29.
Rate formula=Amount/Qty
Regards
Pradeep Kumar Gupta
INDIA
Pradeep Kumar Gupta
INDIA
-
- Administrator
- Posts: 78647
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Construct a report from 2 sheets have individual parts
Code: Select all
Sub CreateList()
' First data row
Const FirstRow = 6
Dim wshC As Worksheet
Dim wshP As Worksheet
Dim wshS As Worksheet
Dim rngC As Range
Dim celC As Range
Dim rngP As Range
Dim celP As Range
Dim celS As Range
Dim LastRow As Long
Dim lngRow As Long
Application.ScreenUpdating = False
lngRow = FirstRow
' Set references to worksheets
Set wshC = Worksheets("Current")
Set wshP = Worksheets("Previous")
Set wshS = Worksheets("Summary")
' Clear existing data from Summary sheet
wshS.Range("A" & FirstRow & ":K" & wshS.Rows.Count).ClearContents
' Used range in column B on Current sheet
LastRow = wshC.Range("B" & wshC.Rows.Count).End(xlUp).Row
Set rngC = wshC.Range("B" & FirstRow & ":B" & LastRow)
' Used range in column B on Previous sheet
LastRow = wshP.Range("B" & wshP.Rows.Count).End(xlUp).Row
Set rngP = wshP.Range("B" & FirstRow & ":B" & LastRow)
' Loop through rows on Current sheet
For Each celC In rngC
If celC.Value <> "" Then
' Try to find value on Previous sheet
Set celP = rngP.Find(What:=celC.Value, LookAt:=xlWhole)
If celP Is Nothing Then
Set celS = wshS.Range("B:B").Find(What:=celC.Value, LookAt:=xlWhole)
If celS Is Nothing Then
lngRow = lngRow + 1
wshS.Range("B" & lngRow & ":E" & lngRow).Value = _
celC.Resize(ColumnSize:=4).Value
wshS.Range("G" & lngRow).Value = celC.Offset(ColumnOffset:=4).Value
wshS.Range("I" & lngRow).Value = celC.Offset(ColumnOffset:=5).Value
wshS.Range("K" & lngRow).Value = "Does not appear in Previous sheet"
Else
celS.Offset(ColumnOffset:=3).Value = celS.Offset(ColumnOffset:=3).Value + _
celC.Offset(ColumnOffset:=3).Value
celS.Offset(ColumnOffset:=5).Value = celS.Offset(ColumnOffset:=5).Value + _
celC.Offset(ColumnOffset:=4).Value
celS.Offset(ColumnOffset:=7).Value = celS.Offset(ColumnOffset:=7).Value + _
celC.Offset(ColumnOffset:=5).Value
End If
End If
End If
Next celC
' Loop through rows on Previous sheet
For Each celP In rngP
If celP.Value <> "" Then
' Try to find value on Current sheet
Set celC = rngC.Find(What:=celP.Value, LookAt:=xlWhole)
If celC Is Nothing Then
Set celS = wshS.Range("B:B").Find(What:=celP.Value, LookAt:=xlWhole)
If celS Is Nothing Then
lngRow = lngRow + 1
wshS.Range("B" & lngRow & ":D" & lngRow).Value = _
celP.Resize(ColumnSize:=3).Value
wshS.Range("F" & lngRow).Value = celP.Offset(ColumnOffset:=3).Value
wshS.Range("H" & lngRow).Value = celP.Offset(ColumnOffset:=4).Value
wshS.Range("J" & lngRow).Value = celP.Offset(ColumnOffset:=5).Value
wshS.Range("K" & lngRow).Value = "Does not appear in Current sheet"
Else
celS.Offset(ColumnOffset:=4).Value = celS.Offset(ColumnOffset:=4).Value + _
celP.Offset(ColumnOffset:=3).Value
celP.Offset(ColumnOffset:=6).Value = celS.Offset(ColumnOffset:=6).Value + _
celC.Offset(ColumnOffset:=4).Value
celP.Offset(ColumnOffset:=8).Value = celS.Offset(ColumnOffset:=8).Value + _
celC.Offset(ColumnOffset:=5).Value
End If
End If
End If
Next celP
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 354
- Joined: 27 Oct 2013, 15:11
- Location: Gurgaon INDIA
Re: Construct a report from 2 sheets have individual parts
Only the rate calculation formula has disturbed.It should be 'Amount'/'Qty'.The formulas on all the rows are ok except the rows 13 and 14.It should be as rows 26 and 27 and cell no.G26 and 27.
Please refer my attach file .
Please refer my attach file .
Regards
Pradeep Kumar Gupta
INDIA
Pradeep Kumar Gupta
INDIA
-
- Administrator
- Posts: 78647
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Construct a report from 2 sheets have individual parts
It helps if you explain the conditions beforehand instead of bit by bit after each reply.
Code: Select all
Sub CreateList()
' First data row
Const FirstRow = 6
Dim wshC As Worksheet
Dim wshP As Worksheet
Dim wshS As Worksheet
Dim rngC As Range
Dim celC As Range
Dim rngP As Range
Dim celP As Range
Dim celS As Range
Dim LastRow As Long
Dim lngRow As Long
Application.ScreenUpdating = False
lngRow = FirstRow
' Set references to worksheets
Set wshC = Worksheets("Current")
Set wshP = Worksheets("Previous")
Set wshS = Worksheets("Summary")
' Clear existing data from Summary sheet
wshS.Range("A" & FirstRow & ":K" & wshS.Rows.Count).ClearContents
' Used range in column B on Current sheet
LastRow = wshC.Range("B" & wshC.Rows.Count).End(xlUp).Row
Set rngC = wshC.Range("B" & FirstRow & ":B" & LastRow)
' Used range in column B on Previous sheet
LastRow = wshP.Range("B" & wshP.Rows.Count).End(xlUp).Row
Set rngP = wshP.Range("B" & FirstRow & ":B" & LastRow)
' Loop through rows on Current sheet
For Each celC In rngC
If celC.Value <> "" Then
' Try to find value on Previous sheet
Set celP = rngP.Find(What:=celC.Value, LookAt:=xlWhole)
If celP Is Nothing Then
Set celS = wshS.Range("B:B").Find(What:=celC.Value, LookAt:=xlWhole)
If celS Is Nothing Then
lngRow = lngRow + 1
wshS.Range("B" & lngRow & ":E" & lngRow).Value = _
celC.Resize(ColumnSize:=4).Value
wshS.Range("I" & lngRow).Value = celC.Offset(ColumnOffset:=5).Value
wshS.Range("G" & lngRow).Value = wshS.Range("I" & lngRow).Value / _
wshS.Range("E" & lngRow).Value
wshS.Range("K" & lngRow).Value = "Does not appear in Previous sheet"
Else
celS.Offset(ColumnOffset:=3).Value = celS.Offset(ColumnOffset:=3).Value + _
celC.Offset(ColumnOffset:=3).Value
celS.Offset(ColumnOffset:=7).Value = celS.Offset(ColumnOffset:=7).Value + _
celC.Offset(ColumnOffset:=5).Value
celS.Offset(ColumnOffset:=5).Value = celS.Offset(ColumnOffset:=7).Value / _
celS.Offset(ColumnOffset:=3).Value
End If
End If
End If
Next celC
' Loop through rows on Previous sheet
For Each celP In rngP
If celP.Value <> "" Then
' Try to find value on Current sheet
Set celC = rngC.Find(What:=celP.Value, LookAt:=xlWhole)
If celC Is Nothing Then
Set celS = wshS.Range("B:B").Find(What:=celP.Value, LookAt:=xlWhole)
If celS Is Nothing Then
lngRow = lngRow + 1
wshS.Range("B" & lngRow & ":D" & lngRow).Value = _
celP.Resize(ColumnSize:=3).Value
wshS.Range("F" & lngRow).Value = celP.Offset(ColumnOffset:=3).Value
wshS.Range("J" & lngRow).Value = celP.Offset(ColumnOffset:=5).Value
wshS.Range("H" & lngRow).Value = wshS.Range("J" & lngRow).Value / _
wshS.Range("F" & lngRow).Value
wshS.Range("K" & lngRow).Value = "Does not appear in Current sheet"
Else
celS.Offset(ColumnOffset:=4).Value = celS.Offset(ColumnOffset:=4).Value + _
celP.Offset(ColumnOffset:=3).Value
celS.Offset(ColumnOffset:=8).Value = celS.Offset(ColumnOffset:=8).Value + _
celP.Offset(ColumnOffset:=5).Value
celS.Offset(ColumnOffset:=6).Value = celS.Offset(ColumnOffset:=8).Value / _
celS.Offset(ColumnOffset:=4).Value
End If
End If
End If
Next celP
Application.ScreenUpdating = True
End Sub
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 354
- Joined: 27 Oct 2013, 15:11
- Location: Gurgaon INDIA
Re: Construct a report from 2 sheets have individual parts
Sorry for my earlier mistakes.
Now,the perfect macro is in my hand and working so well as I desired.Very glad to find the same.
Thanks a lot Hans for all credit.
Now,the perfect macro is in my hand and working so well as I desired.Very glad to find the same.
Thanks a lot Hans for all credit.
Regards
Pradeep Kumar Gupta
INDIA
Pradeep Kumar Gupta
INDIA