I have the code below that updates data on the "Audit Sheet" with specific data from the "Master" sheet, prints the "Audit" sheet and loops until the last row is empty. It works great for a small amount of data, but I have another project that will have over 1800 rows of data. I don't want to clog up the printer with 1800 pages all at once.
What I want is to be able to have a box pop up and specify the beginning row and ending row. I have done this before, but I have forgotten over the years of how I originally wrote the code. Any help is appreciated.
Sub testLoopPaste()
Dim i As Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Set wb = ThisWorkbook
Set sht1 = wb.Sheets("Master")
Set sht2 = wb.Sheets("Audit Sheet")
Application.ScreenUpdating = False
'Find the last row (in column A) with data.
LastRow = sht1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
'This is the beginning of the loop
For i = 2 To LastRow
'First activity
sht2.Range("B1" & ii) = sht1.Range("B" & i).Value
sht2.Range("B2" & ii) = sht1.Range("A" & i).Value
sht2.Range("B3" & ii) = sht1.Range("N" & i).Value
sht2.Range("H1" & ii) = sht1.Range("C" & i).Value
sht2.Range("H2" & ii) = sht1.Range("I" & i).Value
sht2.Range("H3" & ii) = sht1.Range("F" & i).Value
sht2.Range("K1" & ii) = sht1.Range("D" & i).Value
sht2.PrintOut
Next i
Application.ScreenUpdating = True
End Sub
You want to loop over a range object in a manner similar to
dim rngobj, userinputstart, userinputend as variant
set rngobj = Range(Range(userinputstart),Range(userinputend))
For each therow in rngobj
'do stuff here
Next
Depending on how you grab user input you're going to have to fiddle with that part.
Thank you to all who posted. I finally figured out what worked best. Here is my finished code and it works perfectly.
Sub testLoopPaste()
Dim i As Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Set wb = ThisWorkbook
Set sht1 = wb.Sheets("Master")
Set sht2 = wb.Sheets("Audit Sheet")
Application.ScreenUpdating = False
'Find the last row of data
LastRow = InputBox("Enter the last row of data", "End Row")
'This is the beginning of the loop
For i = InputBox("Enter the first row of data", "Start Row") To LastRow
'First activity
sht2.Range("B2" & ii) = sht1.Range("B" & i).Value
sht2.Range("B4" & ii) = sht1.Range("C" & i).Value
sht2.Range("B6" & ii) = sht1.Range("D" & i).Value
sht2.Range("B8" & ii) = sht1.Range("L" & i).Value
sht2.Range("B10" & ii) = sht1.Range("M" & i).Value
sht2.Range("B12" & ii) = sht1.Range("N" & i).Value
sht2.Range("B14" & ii) = sht1.Range("Q" & i).Value
sht2.Range("B16" & ii) = sht1.Range("R" & i).Value
sht2.Range("B18" & ii) = sht1.Range("AO" & i).Value
sht2.Range("D2" & ii) = sht1.Range("J" & i).Value
sht2.Range("D4" & ii) = sht1.Range("K" & i).Value
sht2.Range("D6" & ii) = sht1.Range("O" & i).Value
sht2.Range("D8" & ii) = sht1.Range("A" & i).Value
sht2.Range("D10" & ii) = sht1.Range("AO" & i).Value
sht2.Range("D12" & ii) = sht1.Range("T" & i).Value
sht2.Range("D14" & ii) = sht1.Range("U" & i).Value
sht2.Range("D16" & ii) = sht1.Range("V" & i).Value
sht2.Range("D18" & ii) = sht1.Range("W" & i).Value
sht2.Range("D20" & ii) = sht1.Range("X" & i).Value
sht2.Range("D22" & ii) = sht1.Range("Y" & i).Value
sht2.Range("D24" & ii) = sht1.Range("Z" & i).Value
sht2.Range("D26" & ii) = sht1.Range("AA" & i).Value
sht2.Range("D28" & ii) = sht1.Range("AB" & i).Value
sht2.Range("D35" & ii) = sht1.Range("AT" & i).Value
sht2.Range("D37" & ii) = sht1.Range("AV" & i).Value
sht2.Range("D39" & ii) = sht1.Range("AX" & i).Value
sht2.Range("D41" & ii) = sht1.Range("AZ" & i).Value
sht2.Range("D43" & ii) = sht1.Range("BB" & i).Value
sht2.Range("D45" & ii) = sht1.Range("BD" & i).Value
sht2.Range("D47" & ii) = sht1.Range("BF" & i).Value
sht2.Range("D49" & ii) = sht1.Range("BH" & i).Value
sht2.Range("D51" & ii) = sht1.Range("BJ" & i).Value
sht2.Range("D53" & ii) = sht1.Range("BL" & i).Value
sht2.Range("D55" & ii) = sht1.Range("BN" & i).Value
sht2.Range("I2" & ii) = sht1.Range("F" & i).Value
sht2.Range("I4" & ii) = sht1.Range("G" & i).Value
sht2.Range("I6" & ii) = sht1.Range("S" & i).Value
sht2.Range("I8" & ii) = sht1.Range("AM" & i).Value
sht2.Range("I10" & ii) = sht1.Range("AN" & i).Value
sht2.Range("H12" & ii) = sht1.Range("AD" & i).Value
sht2.Range("H14" & ii) = sht1.Range("AE" & i).Value
sht2.Range("H16" & ii) = sht1.Range("AF" & i).Value
sht2.Range("H18" & ii) = sht1.Range("AG" & i).Value
sht2.Range("H20" & ii) = sht1.Range("AH" & i).Value
sht2.Range("H22" & ii) = sht1.Range("AQ" & i).Value
sht2.Range("H24" & ii) = sht1.Range("AI" & i).Value
sht2.Range("H26" & ii) = sht1.Range("AJ" & i).Value
sht2.Range("H28" & ii) = sht1.Range("AK" & i).Value
sht2.Range("H30" & ii) = sht1.Range("AL" & i).Value
sht2.Range("H35" & ii) = sht1.Range("AU" & i).Value
sht2.Range("H37" & ii) = sht1.Range("AW" & i).Value
sht2.Range("H39" & ii) = sht1.Range("AY" & i).Value
sht2.Range("H41" & ii) = sht1.Range("BA" & i).Value
sht2.Range("H43" & ii) = sht1.Range("BC" & i).Value
sht2.Range("H45" & ii) = sht1.Range("BE" & i).Value
sht2.Range("H47" & ii) = sht1.Range("BG" & i).Value
sht2.Range("H49" & ii) = sht1.Range("BI" & i).Value
sht2.Range("H51" & ii) = sht1.Range("BK" & i).Value
sht2.Range("H53" & ii) = sht1.Range("BM" & i).Value
sht2.Range("H55" & ii) = sht1.Range("BO" & i).Value
sht2.PrintOut
Next i
Application.ScreenUpdating = True
End Sub
Related
Line 4 is messing my loop up with a type mismatch! What am I doing wrong?
For i = 4 To 8
j = 20 + i
Col = Columns(j)
Range("'" & Col & "3'").FormulaR1C1 = "=IF(RC[-11]=0,0,(IF(SUMIF(R3C2:R" & lRow & "C2, RC2,R3C" & i & ":R" & lRow & "C" & i & ")>RC[-11]*1000000, SUMIF(R3C2:R" & lRow1 & "C2, RC2,R3C" & i & ":R" & lRow & "C" & i & ")- RC[-11]*1000000,0)))"
Next i
Try this:
For i = 4 To 8
Cells(3, 20 + i).FormulaR1C1 = "=IF(RC[-11]=0,0,(IF(SUMIF(R3C2:R" & lRow & "C2, RC2,R3C" & i & ":R" & lRow & "C" & i & ")>RC[-11]*1000000, SUMIF(R3C2:R" & lRow1 & "C2, RC2,R3C" & i & ":R" & lRow & "C" & i & ")- RC[-11]*1000000,0)))"
Next i
By using Cells or Range on their own Excel will assume you want to reference the active worksheet, in the active workbook. It's a much better idea to specify exactly which workbook/ worksheet you want the code to run on. E.g.:
For i = 4 To 8
ThisWorkbook.Worksheets("Sheet1").Cells(3, 20 + i).FormulaR1C1 = "=IF(RC[-11]=0,0,(IF(SUMIF(R3C2:R" & lRow & "C2, RC2,R3C" & i & ":R" & lRow & "C" & i & ")>RC[-11]*1000000, SUMIF(R3C2:R" & lRow1 & "C2, RC2,R3C" & i & ":R" & lRow & "C" & i & ")- RC[-11]*1000000,0)))"
Next i
You're doing many errors.
First, col is a column, not a (range address) string. You cannot concatenate a column to a string.
Second, you should not enclose a range address with single-quotes (').
What you probably wanted to do is:
Cells(3, j).Formula = ...
I have now completed my intended worksheet to accomplish what I want it to do. However, the code seems to be very heavy and my computer screen flickers so that I almost get an epileptic seizure. I am hoping that maybe there is something that can be done, but I need your help in acheiving this.
The "system" consists of two files, a userfile (the one that flickers) and a database file.
When I run either the full update or the "new item only" update, it seems to require extensive resources, which I didnt think would be necessary considering the fairly simple task and number of potential lookups. It is all done from the sheet "Sagsnr." in the "Stackoverflow_dummy.xlsm" file.
I have also written the code beneath, but the complete, but sanitized, files are also available here: https://spaces.hightail.com/space/vSKXs.
I hope you guys can help me optimise this.
Sub Worksheet_UpdateAllItemCostData()
Dim material As Variant
Dim fndEntry As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim lr As Long, I As Long, J As Long
Const sPOS As String = "Pos. "
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb1 = ActiveWorkbook
J = 0
lr = wb1.Sheets("Sagsnr.").Cells(Rows.Count, "C").End(xlUp).Row
If lr < 21 Then
Exit Sub
End If
Workbooks.Open Filename:="G:\Backoffice\Tilbudsteam\Kostdatabase\Matcost.xls", ReadOnly:=True
wb1.Sheets("Sagsnr.").Rows("1:1").Hidden = False
Set wb2 = ActiveWorkbook
For I = 21 To lr
wb1.Sheets("Sagsnr.").Rows("1:1").Copy
wb1.Sheets("Sagsnr.").Rows(I).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
wb1.Sheets("Sagsnr.").Rows(I).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
material = wb1.Sheets("Sagsnr.").Range("C" & I).Value
Set fndEntry = wb2.Sheets("Matcost").Range("D:D").Find(What:=material)
If Not material = "" Then
J = J + 1
wb1.Sheets("Sagsnr.").Range("A" & I).Value = sPOS & J
End If
If Not fndEntry Is Nothing Then
'If you want to include the formatting from the source file, use below:
'wb2.Sheets("Source sheet - change me").Range("source column - change me" & fndEntry.Row).Copy Destination:=wb1.Sheets("destination sheet - change me").Range("destination column - change me" & i)
'If you want to keep the formatting of the target file, use below:
'wb1.Sheets("Source sheet - change me").Range("source column - change me" & i).Value = wb2.Sheets("destination sheet").Range("destination column" & fndEntry.Row).Value
wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value 'Product group
wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value 'Available Stock
wb1.Sheets("Sagsnr.").Range("F" & I).Value = wb2.Sheets("Matcost").Range("E" & fndEntry.Row).Value 'Materiale name
wb1.Sheets("Sagsnr.").Range("H" & I).Value = wb2.Sheets("Matcost").Range("AJ" & fndEntry.Row).Value 'Marked for deletion
wb1.Sheets("Sagsnr.").Range("I" & I).Value = wb2.Sheets("Matcost").Range("M" & fndEntry.Row).Value 'Datasheet
wb1.Sheets("Sagsnr.").Range("K" & I).Value = wb2.Sheets("Matcost").Range("P" & fndEntry.Row).Value 'Lotsize
wb1.Sheets("Sagsnr.").Range("M" & I).Value = wb2.Sheets("Matcost").Range("F" & fndEntry.Row).Value 'Material type (FERT/HAWA)
wb1.Sheets("Sagsnr.").Range("N" & I).Value = wb2.Sheets("Matcost").Range("N" & fndEntry.Row).Value 'Date of Cost update
wb1.Sheets("Sagsnr.").Range("O" & I).Value = wb2.Sheets("Matcost").Range("O" & fndEntry.Row).Value 'Last change of cost data
wb1.Sheets("Sagsnr.").Range("P" & I).Value = wb2.Sheets("Matcost").Range("K" & fndEntry.Row).Value 'Stock category
wb1.Sheets("Sagsnr.").Range("Q" & I).Value = wb2.Sheets("Matcost").Range("L" & fndEntry.Row).Value 'ABC code
wb1.Sheets("Sagsnr.").Range("R" & I).Value = wb2.Sheets("Matcost").Range("V" & fndEntry.Row).Value 'Construction weight Cu
wb1.Sheets("Sagsnr.").Range("S" & I).Value = wb2.Sheets("Matcost").Range("W" & fndEntry.Row).Value 'Construction weight Al
wb1.Sheets("Sagsnr.").Range("T" & I).Value = wb2.Sheets("Matcost").Range("X" & fndEntry.Row).Value 'Sales weight Cu
wb1.Sheets("Sagsnr.").Range("U" & I).Value = wb2.Sheets("Matcost").Range("Y" & fndEntry.Row).Value 'Sales weight Al
wb1.Sheets("Sagsnr.").Range("AC" & I).Value = wb2.Sheets("Matcost").Range("Z" & fndEntry.Row).Value 'Construction weight PE
wb1.Sheets("Sagsnr.").Range("AD" & I).Value = wb2.Sheets("Matcost").Range("AD" & fndEntry.Row).Value 'PE costs
wb1.Sheets("Sagsnr.").Range("AE" & I).Value = wb2.Sheets("Matcost").Range("AA" & fndEntry.Row).Value 'Construction weight PVC
wb1.Sheets("Sagsnr.").Range("AF" & I).Value = wb2.Sheets("Matcost").Range("AE" & fndEntry.Row).Value 'PVC costs
wb1.Sheets("Sagsnr.").Range("AG" & I).Value = wb2.Sheets("Matcost").Range("AF" & fndEntry.Row).Value 'Other materials costs
wb1.Sheets("Sagsnr.").Range("AH" & I).Value = wb2.Sheets("Matcost").Range("AB" & fndEntry.Row).Value 'Variable production costs
wb1.Sheets("Sagsnr.").Range("AI" & I).Value = wb2.Sheets("Matcost").Range("AC" & fndEntry.Row).Value 'Fixed production costs
End If
Set fndEntry = wb2.Sheets("Matcost").Range("C:C").Find(What:=material)
If Not fndEntry Is Nothing Then
'If you want to include the formatting from the source file, use below:
'wb2.Sheets("Source sheet - change me").Range("source column - change me" & fndEntry.Row).Copy Destination:=wb1.Sheets("destination sheet - change me").Range("destination column - change me" & i)
'If you want to keep the formatting of the target file, use below:
'wb1.Sheets("Source sheet - change me").Range("source column - change me" & i).Value = wb2.Sheets("destination sheet").Range("destination column" & fndEntry.Row).Value
wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value 'Product group
wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value 'Available Stock
wb1.Sheets("Sagsnr.").Range("F" & I).Value = wb2.Sheets("Matcost").Range("E" & fndEntry.Row).Value 'Materiale name
wb1.Sheets("Sagsnr.").Range("H" & I).Value = wb2.Sheets("Matcost").Range("AJ" & fndEntry.Row).Value 'Marked for deletion
wb1.Sheets("Sagsnr.").Range("I" & I).Value = wb2.Sheets("Matcost").Range("M" & fndEntry.Row).Value 'Datasheet
wb1.Sheets("Sagsnr.").Range("K" & I).Value = wb2.Sheets("Matcost").Range("P" & fndEntry.Row).Value 'Lotsize
wb1.Sheets("Sagsnr.").Range("M" & I).Value = wb2.Sheets("Matcost").Range("F" & fndEntry.Row).Value 'Material type (FERT/HAWA)
wb1.Sheets("Sagsnr.").Range("N" & I).Value = wb2.Sheets("Matcost").Range("N" & fndEntry.Row).Value 'Date of Cost update
wb1.Sheets("Sagsnr.").Range("O" & I).Value = wb2.Sheets("Matcost").Range("O" & fndEntry.Row).Value 'Last change of cost data
wb1.Sheets("Sagsnr.").Range("P" & I).Value = wb2.Sheets("Matcost").Range("K" & fndEntry.Row).Value 'Stock category
wb1.Sheets("Sagsnr.").Range("Q" & I).Value = wb2.Sheets("Matcost").Range("L" & fndEntry.Row).Value 'ABC code
wb1.Sheets("Sagsnr.").Range("R" & I).Value = wb2.Sheets("Matcost").Range("V" & fndEntry.Row).Value 'Construction weight Cu
wb1.Sheets("Sagsnr.").Range("S" & I).Value = wb2.Sheets("Matcost").Range("W" & fndEntry.Row).Value 'Construction weight Al
wb1.Sheets("Sagsnr.").Range("T" & I).Value = wb2.Sheets("Matcost").Range("X" & fndEntry.Row).Value 'Sales weight Cu
wb1.Sheets("Sagsnr.").Range("U" & I).Value = wb2.Sheets("Matcost").Range("Y" & fndEntry.Row).Value 'Sales weight Al
wb1.Sheets("Sagsnr.").Range("AC" & I).Value = wb2.Sheets("Matcost").Range("Z" & fndEntry.Row).Value 'Construction weight PE
wb1.Sheets("Sagsnr.").Range("AD" & I).Value = wb2.Sheets("Matcost").Range("AD" & fndEntry.Row).Value 'PE costs
wb1.Sheets("Sagsnr.").Range("AE" & I).Value = wb2.Sheets("Matcost").Range("AA" & fndEntry.Row).Value 'Construction weight PVC
wb1.Sheets("Sagsnr.").Range("AF" & I).Value = wb2.Sheets("Matcost").Range("AE" & fndEntry.Row).Value 'PVC costs
wb1.Sheets("Sagsnr.").Range("AG" & I).Value = wb2.Sheets("Matcost").Range("AF" & fndEntry.Row).Value 'Other materials costs
wb1.Sheets("Sagsnr.").Range("AH" & I).Value = wb2.Sheets("Matcost").Range("AB" & fndEntry.Row).Value 'Variable production costs
wb1.Sheets("Sagsnr.").Range("AI" & I).Value = wb2.Sheets("Matcost").Range("AC" & fndEntry.Row).Value 'Fixed production costs
End If
Next I
wb2.Close
wb1.Sheets("Sagsnr.").Rows("1:1").Hidden = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub Worksheet_GetNewItemCostData()
Dim material As String
Dim costingdate As Variant
Dim fndEntry As Range, fndCostDate As Range
Dim wb1 As Workbook, wb2 As Workbook
Dim lr As Long, I As Long, J As Long
Const sPOS As String = "Pos. "
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb1 = ActiveWorkbook
J = 0
lr = wb1.Sheets("Sagsnr.").Cells(Rows.Count, "C").End(xlUp).Row
If lr < 21 Then
Exit Sub
End If
Workbooks.Open Filename:="G:\Backoffice\Tilbudsteam\Kostdatabase\Matcost.xls", ReadOnly:=True
wb1.Sheets("Sagsnr.").Rows("1:1").Hidden = False
Set wb2 = ActiveWorkbook
For I = 21 To lr
wb1.Sheets("Sagsnr.").Rows("1:1").Copy
wb1.Sheets("Sagsnr.").Rows(I).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
wb1.Sheets("Sagsnr.").Rows(I).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
material = wb1.Sheets("Sagsnr.").Range("C" & I).Value
costingdate = wb1.Sheets("Sagsnr.").Range("N" & I).Value
If Not material = "" Then
J = J + 1
wb1.Sheets("Sagsnr.").Range("A" & I).Value = sPOS & J
End If
If Not costingdate <> "" Then
Set fndEntry = wb2.Sheets("Matcost").Range("D:D").Find(What:=material)
If Not fndEntry Is Nothing Then
'If you want to include the formatting from the source file, use below:
'wb2.Sheets("Source sheet - change me").Range("source column - change me" & fndEntry.Row).Copy Destination:=wb1.Sheets("destination sheet - change me").Range("destination column - change me" & i)
'If you want to keep the formatting of the target file, use below:
'wb1.Sheets("Source sheet - change me").Range("source column - change me" & i).Value = wb2.Sheets("destination sheet").Range("destination column" & fndEntry.Row).Value
wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value 'Product group
wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value 'Available Stock
wb1.Sheets("Sagsnr.").Range("F" & I).Value = wb2.Sheets("Matcost").Range("E" & fndEntry.Row).Value 'Materiale name
wb1.Sheets("Sagsnr.").Range("H" & I).Value = wb2.Sheets("Matcost").Range("AJ" & fndEntry.Row).Value 'Marked for deletion
wb1.Sheets("Sagsnr.").Range("I" & I).Value = wb2.Sheets("Matcost").Range("M" & fndEntry.Row).Value 'Datasheet
wb1.Sheets("Sagsnr.").Range("K" & I).Value = wb2.Sheets("Matcost").Range("P" & fndEntry.Row).Value 'Lotsize
wb1.Sheets("Sagsnr.").Range("M" & I).Value = wb2.Sheets("Matcost").Range("F" & fndEntry.Row).Value 'Material type (FERT/HAWA)
wb1.Sheets("Sagsnr.").Range("N" & I).Value = wb2.Sheets("Matcost").Range("N" & fndEntry.Row).Value 'Date of Cost update
wb1.Sheets("Sagsnr.").Range("O" & I).Value = wb2.Sheets("Matcost").Range("O" & fndEntry.Row).Value 'Last change of cost data
wb1.Sheets("Sagsnr.").Range("P" & I).Value = wb2.Sheets("Matcost").Range("K" & fndEntry.Row).Value 'Stock category
wb1.Sheets("Sagsnr.").Range("Q" & I).Value = wb2.Sheets("Matcost").Range("L" & fndEntry.Row).Value 'ABC code
wb1.Sheets("Sagsnr.").Range("R" & I).Value = wb2.Sheets("Matcost").Range("V" & fndEntry.Row).Value 'Construction weight Cu
wb1.Sheets("Sagsnr.").Range("S" & I).Value = wb2.Sheets("Matcost").Range("W" & fndEntry.Row).Value 'Construction weight Al
wb1.Sheets("Sagsnr.").Range("T" & I).Value = wb2.Sheets("Matcost").Range("X" & fndEntry.Row).Value 'Sales weight Cu
wb1.Sheets("Sagsnr.").Range("U" & I).Value = wb2.Sheets("Matcost").Range("Y" & fndEntry.Row).Value 'Sales weight Al
wb1.Sheets("Sagsnr.").Range("AC" & I).Value = wb2.Sheets("Matcost").Range("Z" & fndEntry.Row).Value 'Construction weight PE
wb1.Sheets("Sagsnr.").Range("AD" & I).Value = wb2.Sheets("Matcost").Range("AD" & fndEntry.Row).Value 'PE costs
wb1.Sheets("Sagsnr.").Range("AE" & I).Value = wb2.Sheets("Matcost").Range("AA" & fndEntry.Row).Value 'Construction weight PVC
wb1.Sheets("Sagsnr.").Range("AF" & I).Value = wb2.Sheets("Matcost").Range("AE" & fndEntry.Row).Value 'PVC costs
wb1.Sheets("Sagsnr.").Range("AG" & I).Value = wb2.Sheets("Matcost").Range("AF" & fndEntry.Row).Value 'Other materials costs
wb1.Sheets("Sagsnr.").Range("AH" & I).Value = wb2.Sheets("Matcost").Range("AB" & fndEntry.Row).Value 'Variable production costs
wb1.Sheets("Sagsnr.").Range("AI" & I).Value = wb2.Sheets("Matcost").Range("AC" & fndEntry.Row).Value 'Fixed production costs
End If
Set fndEntry = wb2.Sheets("Matcost").Range("C:C").Find(What:=material)
If Not fndEntry Is Nothing Then
'If you want to include the formatting from the source file, use below:
'wb2.Sheets("Source sheet - change me").Range("source column - change me" & fndEntry.Row).Copy Destination:=wb1.Sheets("destination sheet - change me").Range("destination column - change me" & i)
'If you want to keep the formatting of the target file, use below:
'wb1.Sheets("Source sheet - change me").Range("source column - change me" & i).Value = wb2.Sheets("destination sheet").Range("destination column" & fndEntry.Row).Value
wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value 'Product group
wb1.Sheets("Sagsnr.").Range("E" & I).Value = wb2.Sheets("Matcost").Range("Q" & fndEntry.Row).Value 'Available Stock
wb1.Sheets("Sagsnr.").Range("F" & I).Value = wb2.Sheets("Matcost").Range("E" & fndEntry.Row).Value 'Materiale name
wb1.Sheets("Sagsnr.").Range("H" & I).Value = wb2.Sheets("Matcost").Range("AJ" & fndEntry.Row).Value 'Marked for deletion
wb1.Sheets("Sagsnr.").Range("I" & I).Value = wb2.Sheets("Matcost").Range("M" & fndEntry.Row).Value 'Datasheet
wb1.Sheets("Sagsnr.").Range("K" & I).Value = wb2.Sheets("Matcost").Range("P" & fndEntry.Row).Value 'Lotsize
wb1.Sheets("Sagsnr.").Range("M" & I).Value = wb2.Sheets("Matcost").Range("F" & fndEntry.Row).Value 'Material type (FERT/HAWA)
wb1.Sheets("Sagsnr.").Range("N" & I).Value = wb2.Sheets("Matcost").Range("N" & fndEntry.Row).Value 'Date of Cost update
wb1.Sheets("Sagsnr.").Range("O" & I).Value = wb2.Sheets("Matcost").Range("O" & fndEntry.Row).Value 'Last change of cost data
wb1.Sheets("Sagsnr.").Range("P" & I).Value = wb2.Sheets("Matcost").Range("K" & fndEntry.Row).Value 'Stock category
wb1.Sheets("Sagsnr.").Range("Q" & I).Value = wb2.Sheets("Matcost").Range("L" & fndEntry.Row).Value 'ABC code
wb1.Sheets("Sagsnr.").Range("R" & I).Value = wb2.Sheets("Matcost").Range("V" & fndEntry.Row).Value 'Construction weight Cu
wb1.Sheets("Sagsnr.").Range("S" & I).Value = wb2.Sheets("Matcost").Range("W" & fndEntry.Row).Value 'Construction weight Al
wb1.Sheets("Sagsnr.").Range("T" & I).Value = wb2.Sheets("Matcost").Range("X" & fndEntry.Row).Value 'Sales weight Cu
wb1.Sheets("Sagsnr.").Range("U" & I).Value = wb2.Sheets("Matcost").Range("Y" & fndEntry.Row).Value 'Sales weight Al
wb1.Sheets("Sagsnr.").Range("AC" & I).Value = wb2.Sheets("Matcost").Range("Z" & fndEntry.Row).Value 'Construction weight PE
wb1.Sheets("Sagsnr.").Range("AD" & I).Value = wb2.Sheets("Matcost").Range("AD" & fndEntry.Row).Value 'PE costs
wb1.Sheets("Sagsnr.").Range("AE" & I).Value = wb2.Sheets("Matcost").Range("AA" & fndEntry.Row).Value 'Construction weight PVC
wb1.Sheets("Sagsnr.").Range("AF" & I).Value = wb2.Sheets("Matcost").Range("AE" & fndEntry.Row).Value 'PVC costs
wb1.Sheets("Sagsnr.").Range("AG" & I).Value = wb2.Sheets("Matcost").Range("AF" & fndEntry.Row).Value 'Other materials costs
wb1.Sheets("Sagsnr.").Range("AH" & I).Value = wb2.Sheets("Matcost").Range("AB" & fndEntry.Row).Value 'Variable production costs
wb1.Sheets("Sagsnr.").Range("AI" & I).Value = wb2.Sheets("Matcost").Range("AC" & fndEntry.Row).Value 'Fixed production costs
End If
End If
Next I
wb2.Close
wb1.Sheets("Sagsnr.").Rows("1:1").Hidden = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
When you use
wb1.Sheets("Sagsnr.").Range("B" & I).Value = wb2.Sheets("Matcost").Range("H" & fndEntry.Row).Value 'Product group
Excel has to find the sheets "Sagsnr." and "Matcost" and the respective ranges in them for each cell that you copy.
What you can do instead, is to save the worksheets and ranges the same way you do for the Workbooks before the loop:
Dim wsTo As Worksheet, wsFrom As Worksheet
Set wsTo = wb1.Sheets("Sagsnr.")
Set wsFrom = wb2.Sheets("Matcost")
Dim rngTo As Range, rngFrom As Range
Then inside the loop:
Set rngTo = wsTo.Range("A" & I)
Set rngFrom = wsFrom.Range("A" & fndEntry.Row)
rngTo(, "B") = rngFrom(, "H") ' Product group
rngTo(, "E") = rngFrom(, "Q") ' Available Stock
' ... and add the same for the rest of the columns
What can speed it even more is if you can copy ranges of cells at a time instead of cell by cell.
For example, in your case you can filter the source rows and copy the columns:
Dim materials ' As Variant
materials = wsTo.Range("C21:C" & lr)
materials = WorksheetFunction.Transpose(materials) 'flips from "vertical" to "horisontal"
wsFrom.UsedRange.AutoFilter 4, materials, xlFilterValues ' 4 is column D:D in "Matcost"
' set the copy from and paste to ranges
Set rngFrom = wsFrom.Range("A2:A" & wsFrom.UsedRange.Rows.Count) ' skips the header cells
Set rngTo = wsTo.Range("A21") ' to paste on row 21
' "rngTo(, "B") = rngFrom(, "H") ' Product group" becomes:
rngFrom.Columns("H").Copy ' this will copy only the filtered (visible) cells in column H
rngTo(, "B").PasteSpecial ' or wsTo.Range("B21").PasteSpecial
' ... and add the same for the rest of the columns
Application.CutCopyMode = False '"Cancels Cut or Copy mode and removes the moving border"
wsTo.UsedRange.AutoFilter 4 ' optional to clear the filter from column D:D
I have a problem with my vba project.
My workbook has 4 sheets (Draft, cky, coy and bey), in the sheet "draft i have all my data and i want to reorganise them. the columns "G" of the sheet "draft" contains the values (cky, coy and bey).
I want my macro to go through the colums and copy all the cells that have the same value and paste them in their corresponding sheet starting at the cell (A2), for exemple: i want the macro to copy all the data that have "cky" and paste it in the sheet "cky" starting at the cell A2 and so on/
Below you can see what i have done so far:
Sub MainPower()
Dim lmid As String
Dim srange, SelData, ExtBbFor As String
Dim lastrow As Long
Dim i, j, k As Integer
lastrow = ActiveSheet.Range("B30000").End(xlUp).Row
srange = "G1:G" & lastrow
SelData = "A1:G" & lastrow
For i = 1 To lastrow
If InStr(1, LCase(Range("E" & i)), "bb") <> 0 Then
Range("G" & i).Value = Mid(Range("E" & i), 4, 3)
ElseIf Left(Range("E" & i), 1) = "H" Then
Range("G" & i).Value = Mid(Range("E" & i), 7, 3)
Else
Range("G" & i).Value = Mid(Range("E" & i), 1, 3)
End If
Next i
'Sorting data
Range("A1").AutoFilter
Range(SelData).Sort key1:=Range(srange), order1:=xlAscending, Header:=xlYes
'Spreading to the appropriate sheets
j = 1
For i = 1 To lastrow
If Range("G" & i).Value = "CKY" Then
Sheets("CKY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value
ElseIf Range("G" & i).Value = "BEY" Then
Sheets("BEY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value
ElseIf Range("G" & i).Value = "COY" Then
Sheets("COY").Range("A" & j & ":E" & j).Value = Sheets("Draft").Range("C" & i & ":G" & i).Value
End If
j = j + 1
Next i
End Sub
Thank you to help
best regards
Use this refactored code in the For Loop and it should work for better for you:
For i = 1 To lastrow
Select Case Sheets("Draft").Range("G" & i).Value
Case is = "CKY","COY","BEY"
Dim wsPaste as Worksheet
Set wsPaste = Sheets(Range("G"& i).Value)
Dim lRowPaste as Long
lRowPaste = wsPaste.Range("A" & .Rows.COunt).End(xlup).Offset(1).Row
wsPaste.Range("A" & lRowPaste & ":E" & lRowPaste).Value = _
Sheets("Draft").Range("C" & i & ":G" & i).Value
End Select
Next i
I need to check the range from A1 to AY1, B1 to BY1.... from sheet 1 and compare them with the range from A1 to AY1, B1 to BY1.... from sheet 2 and highlight in yellow the difference in sheet 1.
Sub copyWorkingFileToConsolidated()
Dim i As Integer
i = 5
Do While Sheet2.Range("A" & i).Value <> ""
Sheet3.Range("A" & i & ":D" & i).Value = Sheet2.Range("A" & i & ":D" & i).Value
Sheet3.Range("F" & i & ":Y" & i).Value = Sheet2.Range("E" & i & ":X" & i).Value
Sheet3.Range("A" & i & ":Y" & i).Interior.ColorIndex = 0
i = i + 1
Loop
getResourceLevel
End Sub
Please help
Thanks
I have some code to pdf and save my file to a folder on my computer. I've tested in the past and had no problem. However, after making some minor changes i am getting run time error 1004. Any ideas on why this is? Very frustrating. Thank you.
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim i As Long
Dim ws As Worksheet
Dim FileName As String
Set ws = Sheets("Multi")
Set wsJob = Sheets("Job")
FileName = ws.Range("B2")
LastRow = ws.Range("B" & Rows.Count).End(xlUp).Row
For i = 8 To LastRow
wsJob.Activate
wsJob.Range("AZ1").Value = ws.Range("B" & i)
wsJob.Range("AZ2").Value = ws.Range("C" & i)
wsJob.Range("AZ3").Value = ws.Range("D" & i)
wsJob.Range("AZ4").Value = ws.Range("E" & i)
wsJob.Range("AZ5").Value = ws.Range("F" & i)
wsJob.Range("AZ6").Value = ws.Range("G" & i)
wsJob.ComboBox1.Visible = False
wsJob.ComboBox2.Visible = False
wsJob.ComboBox3.Visible = False
wsJob.ComboBox4.Visible = False
wsJob.ComboBox5.Visible = False
wsJob.ComboBox6.Visible = False
wsJob.CommandButton1.Visible = False
wsJob.Rows("4:13").EntireRow.Hidden = True
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=ws.Range("B2") & "TCC Analysis - " & ws.Range("B" & i) & " - " & ws.Range("C" & i) & " - " & ws.Range("D" & i) & " - " & ws.Range("E" & i) & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
Next i
wsJob.ComboBox1.Visible = True
wsJob.ComboBox2.Visible = True
wsJob.ComboBox3.Visible = True
wsJob.ComboBox4.Visible = True
wsJob.ComboBox5.Visible = True
wsJob.ComboBox6.Visible = True
wsJob.CommandButton1.Visible = True
wsJob.Rows("4:13").EntireRow.Hidden = False
ws.Activate
Application.ScreenUpdating = True
End Sub
Replace this line;
FileName:=ws.Range("B2") & "TCC Analysis - " & ws.Range("B" & i) & " - " & ws.Range("C" & i) & " - " & ws.Range("D" & i) & " - " & ws.Range("E" & i) & ".pdf"
with this;
FileName:=ws.Range("B2").value & "TCC Analysis - " & ws.Range("B" & i).value & " - " & ws.Range("C" & i).value & " - " & ws.Range("D" & i).value & " - " & ws.Range("E" & i).value & ".pdf"
Replace;
wsJob.Range("AZ1").Value = ws.Range("B" & i)
wsJob.Range("AZ2").Value = ws.Range("C" & i)
wsJob.Range("AZ3").Value = ws.Range("D" & i)
wsJob.Range("AZ4").Value = ws.Range("E" & i)
wsJob.Range("AZ5").Value = ws.Range("F" & i)
wsJob.Range("AZ6").Value = ws.Range("G" & i)
with this;
wsJob.Range("AZ1").Value = ws.Range("B" & i).Value
wsJob.Range("AZ2").Value = ws.Range("C" & i).Value
wsJob.Range("AZ3").Value = ws.Range("D" & i).Value
wsJob.Range("AZ4").Value = ws.Range("E" & i).Value
wsJob.Range("AZ5").Value = ws.Range("F" & i).Value
wsJob.Range("AZ6").Value = ws.Range("G" & i).Value
Replace
FileName = Sheets("Multi").Range("B2")
with this
FileName = Sheets("Multi").Range("B2").value
Change FileName decleration with different string because FileName is also using in the ActiveSheet.ExportAsFixedFormat line...