I have written below code for copying the data from one workbook to specific cells in another workbook (that's challenge I think, destination file has months and relevant data below it, each month I need to copy the data to the current month column, that's why used "last column" function not to overwrite historical months also to make it dynamic to go to the last column where there is no data which current month ). Even though code is working fine I want to optimize it in order debug easily and avoid future problems when for ex; current year changed. Do you have any ideas how can i make this code better ?
Code
Dim x, LastRow, LastColumn, workfile, sourcefile As String
sourcefile = ActiveWorkbook.Name
workfile = ThisWorkbook.Name
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001B" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "GBP" Then
Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
Workbooks(workfile).Worksheets("A").Activate
Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(28, 21).End(xlToLeft).Column + 1
Workbooks(workfile).Worksheets("A").Cells(28, Lastcolumn2).PasteSpecial xlPasteValues
Else
End If
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001R" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "GBP" Then
Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
Workbooks(workfile).Worksheets("A").Activate
Lastcolumn3 = Workbooks(workfile).Worksheets("A").Cells(29, 21).End(xlToLeft).Column + 1
Workbooks(workfile).Worksheets("A").Cells(29, Lastcolumn3).PasteSpecial xlPasteValues
Else
End If
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001B" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "EUR" Then
Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
Workbooks(workfile).Worksheets("A").Activate
Lastcolumn4 = Workbooks(workfile).Worksheets("A").Cells(35, 21).End(xlToLeft).Column + 1
Workbooks(workfile).Worksheets("A").Cells(35, Lastcolumn4).PasteSpecial xlPasteValues
Else
End If
If Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value = "001R" And Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value = "EUR" Then
Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
Workbooks(workfile).Worksheets("A").Activate
Lastcolumn5 = Workbooks(workfile).Worksheets("A").Cells(36, 21).End(xlToLeft).Column + 1
Workbooks(workfile).Worksheets("A").Cells(36, Lastcolumn5).PasteSpecial xlPasteValues
Else
End If
Next
All you need to do is to determine what the target row is for each of your conditions, then just plug that value into the code block you want to execute. This way you cut out having the same code repeated multiple times.
Here is how you would do that:
Dim x, LastRow, LastColumn, workfile, sourcefile, exchangedownload1, exchangedownload2 As String
Dim targetRow As Integer
sourcefile = ActiveWorkbook.Name
workfile = ThisWorkbook.Name
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
' store the values you are wanting to examine in these 2 variables
exchangedownload1 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value
exchangedownload2 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value
' determine the value for targetRow in this Case statement
Select Case exchangedownload2
Case Is "GBP"
If exchangedownload1 = "001B" Then
targetRow = 28
ElseIf enchangedownload1 = "001R" Then
targetRow = 29
Case Is "EUR"
If exchangedownload1 = "001B" Then
targetRow = 35
ElseIf enchangedownload1 = "001R" Then
targetRow = 36
End Select
' this is your code block that was being repeated with just a
' different value for your targetRow, so just plug the value for
' targetRow where it belongs and you only have to have this code block once
Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
Workbooks(workfile).Worksheets("A").Activate
Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(targetRow, 21).End(xlToLeft).Column + 1
Workbooks(workfile).Worksheets("A").Cells(targetRow, Lastcolumn2).PasteSpecial xlPasteValues
Next
So this the screenshot of the "workfile" where I need to copy the data each month under relevant month column. Impact Rate of Change area just formulas and calculation. So copied are is before that: empty columns currently starting from August, bcoz I ran it already for the July, as I said it works but code seems too complex and hard to debug for another person
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
' store the values you are wanting to examine in these 2 variables
xrate1 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 1).Value
xrate2 = Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 2).Value
' determine the value for targetRow in this Case statement
Select Case xrate2
Case "GBP"
Select Case xrate1
Case "001B": targetrow = 28
Case Else: targetrow = 29
End Select
Select Case xrate2
Case "EUR"
Select Case xrate1
Case "001B": targetrow = 35
Case Else: targetrow = 36
End Select
' copying data
Workbooks(sourcefile).Worksheets("exchangedownload").Cells(x, 8).Copy
Workbooks(workfile).Worksheets("A").Activate
Lastcolumn2 = Workbooks(workfile).Worksheets("A").Cells(targetrow, 21).End(xlToLeft).Column + 1
Workbooks(workfile).Worksheets("A").Cells(targetrow, Lastcolumn2).PasteSpecial xlPasteValues
Next
Above is the adjusted one as I couldn't use If statement with Case, Case is replacement of If, Elseif. But still receiving compile error saying it is "Next without For" and End Select without Case statement((
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.