Scooter172
06-16-2011, 09:30 AM
The following code needs to be changed. This code was inherited so do not know what the writer was thinking.
I want to update a unshared book with this Macro. The code copies information from this book to another. for each Letter named line on the document it requires 2 rows of text. It originally had two rows of text and a blank/Free of data row between the second data row and the new lettered line below. We originally had three lettered lines/three rows each, and now want to have 6 lettered lines of 2 rows each with no blank lines between that transfer.
'Line 6
intI = 1
intJ = 1
Dim intK As Integer 'text index for swap warrant
Dim intL As Integer 'text index for active warrant
intK = 1
intL = 1
For Each C In ThisWorkbook.Sheets("LRV p1").[lrv1Line6Current]
If C = True Then
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6letter].Cells(intL, 1)
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6text].Cells(intK, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6text].Cells(intL, 1)
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6text].Cells(intK + 1, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6text].Cells(intL + 1, 1)
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6text].Cells(intK + 2, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6text].Cells(intL + 2, 1)
intJ = intJ + 1
intK = intK + 3
End If
intI = intI + 1
intL = intL + 3
Next C
If intK <= 7 Then 'fill in the rest of the letters skipping "l" and going to "a" after "Z" starting with nextLetter and continuing in order
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1nextLetter].Cells(6, 1)
intK = intK + 3
End If
Do While intK <= 7 'as is this Do Loop will run at most once. Programmed this way for consistency with other lines and to allow easier expansion if more line 6's are added
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK - 3, 1) + 1
If Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = 108 Then
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = 109
Else
If Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = 123 Then Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intL, 1) = 97
End If
intK = intK + 3
Loop
Workbooks("OpsTableSwapFile.xlsx").Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub
I want to update a unshared book with this Macro. The code copies information from this book to another. for each Letter named line on the document it requires 2 rows of text. It originally had two rows of text and a blank/Free of data row between the second data row and the new lettered line below. We originally had three lettered lines/three rows each, and now want to have 6 lettered lines of 2 rows each with no blank lines between that transfer.
'Line 6
intI = 1
intJ = 1
Dim intK As Integer 'text index for swap warrant
Dim intL As Integer 'text index for active warrant
intK = 1
intL = 1
For Each C In ThisWorkbook.Sheets("LRV p1").[lrv1Line6Current]
If C = True Then
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6letter].Cells(intL, 1)
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6text].Cells(intK, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6text].Cells(intL, 1)
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6text].Cells(intK + 1, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6text].Cells(intL + 1, 1)
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6text].Cells(intK + 2, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1Line6text].Cells(intL + 2, 1)
intJ = intJ + 1
intK = intK + 3
End If
intI = intI + 1
intL = intL + 3
Next C
If intK <= 7 Then 'fill in the rest of the letters skipping "l" and going to "a" after "Z" starting with nextLetter and continuing in order
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = ThisWorkbook.Sheets("LRV p1").[lrv1nextLetter].Cells(6, 1)
intK = intK + 3
End If
Do While intK <= 7 'as is this Do Loop will run at most once. Programmed this way for consistency with other lines and to allow easier expansion if more line 6's are added
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK - 3, 1) + 1
If Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = 108 Then
Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = 109
Else
If Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intK, 1) = 123 Then Workbooks("OpsTableSwapFile.xlsx").Sheets("lrvWar1").[swapLine6letter].Cells(intL, 1) = 97
End If
intK = intK + 3
Loop
Workbooks("OpsTableSwapFile.xlsx").Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub