Reputation: 43
I'm new to VBA entirely but have spent about a week tinkering with it. I'm in the process of trying to automate a pretty intensive task in excel through a combination of recording and messing about with the code from internet searches and my limited research into VBA. I've actually gotten pretty far into the process, but I've run into a problem that I can't seem to find info on. I assume it's a common issue so there is probably already stuff on it, I'm just not typing in the magic combination of words to search for the right answers.
My problem is this: I have a worksheet with about 10,000 rows of data and from this raw data I need to create 60 or so separate spreadsheets for 60 different companies- so around 160 some row actually pertain to a given client. However, it's not fixed and from one month to the next the actual number of rows changes so I can't just use a simple range. There are two possible ways to mark that the data pertains to a new client. In column 1 if the cell says null, it marks the start of new client data. Or, column 2 contains the name of the client, so if the cell in column b does not equal the cell directly above it also will mark the start of new client data.
The key point is that I need to select and cut all the data for each client and paste it into a newly opened workbook.
I've looked into a couple of ways to do this and am now researching for loops and while loops. can anyone suggest a possible structure to do this or a resource that might help?
Updated Code:
Sub copyStuff()
Dim rowStart As Integer
Dim rowEnd As Integer
Dim rowMax As Integer
Dim colMax As Integer
Dim bookName As String
Dim thisWB As String
thisWB = ThisWorkbook.Name
rowMax = ActiveSheet.UsedRange.Rows.Count + 1
colMax = ActiveSheet.UsedRange.Columns.Count
rowStart = 2
For x = 3 To rowMax
If Cells(x, 2) = Cells(x - 1, 2) Then
'
Else
rowEnd = x - 1
Range(Cells(rowStart, 1), Cells(rowEnd, colMax)).Copy
Set NewBook = Workbooks.Add
Range("A2").PasteSpecial (xlPasteValues)
bookName = Cells(rowStart, 2).Value
NewBook.SaveAs Filename:=bookName
Workbooks(thisWB).Activate
Range(Cells(1, 1), Cells(1, colMax)).Copy
Workbooks(bookName).Activate
Range("A1").PasteSpecial (xlPasteValues)
ActiveSheet.Name = "Daily Summary"
ActiveWorkbook.Save
Workbooks(thisWB).Activate
Worksheets("transaction details").Activate
If Cells(x, 2) = Cells(x - 1, 2) Then
'
Else
rowEnd = x - 1
Range(Cells(rowStart, 1), Cells(rowEnd, colMax)).Copy
NewBook.Activate
Range("A2").PasteSpecial (xlPasteValues)
Sheets.Add.Name = "Transaction Details"
Workbooks(thisWB).Worksheet("Transaction Details").Activate
Range(Cells(1, 1), Cells(1, colMax)).Copy
Workbooks(bookName).Activate
Range("A1").PasteSpecial (xlPasteValues)
End If
Workbooks(bookName).Activate
Worksheets("Daily Summary").Activate
Columns("B").Delete
Range("A1:O1").Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A30:O30").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Font.Bold = True
Range("C2:O29").Select
Range("C29").Activate
Selection.Style = "Currency"
Columns("A:A").Select
Selection.NumberFormat = "m/d/yyyy"
ActiveCell.Replace What:="Null", Replacement:="Total", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("D22").Select
Cells.Select
Cells.EntireColumn.AutoFit
ActiveWorkbook.Sheets.Add.Name = "Summary"
ActiveWorkbook.Worksheets("Summary").Activate
Range("A1").Select
ActiveCell.FormulaR1C1 = "Description"
Range("B1").Select
ActiveCell.FormulaR1C1 = "=EOMONTH(TODAY(),-2)+1"
Selection.NumberFormat = "m/d/yyyy"
Range("A1:B1").Select
Range("A1:B1").Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B1").Select
CellContentCanBeInterpretedAsADate = True
Range("A2").Select
ActiveCell.FormulaR1C1 = "Total Amex Charges"
Range("A3").Select
ActiveCell.FormulaR1C1 = "Total Visa Charges"
Range("A4").Select
ActiveCell.FormulaR1C1 = "Total MasterCard Charges"
Range("A5").Select
ActiveCell.FormulaR1C1 = "Total Discover Charges"
Range("A6").Select
ActiveCell.FormulaR1C1 = "Total Credit Card Charges"
Range("A6:B6").Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Cells.Select
Cells.EntireColumn.AutoFit
Range("A8").Select
ActiveCell.FormulaR1C1 = "Amex Transaction Fee (.05/per)"
Range("A9").Select
ActiveCell.FormulaR1C1 = "MasterCard Card Fees"
Range("A10").Select
ActiveCell.FormulaR1C1 = "Visa Card Fees"
Range("A11").Select
ActiveCell.FormulaR1C1 = "Discover Fees"
Range("A12").Select
ActiveCell.FormulaR1C1 = "Total Card Fees"
Range("A12:B12").Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Cells.Select
Cells.EntireColumn.AutoFit
Range("A14").Select
ActiveCell.FormulaR1C1 = "xx Management Fee"
Range("A15").Select
ActiveCell.FormulaR1C1 = "Total xx Fees"
Range("A15:B15").Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A17").Select
ActiveCell.FormulaR1C1 = "Equipment Payment Fee"
Range("A18").Select
ActiveCell.FormulaR1C1 = "Total Equipment Fees"
Range("A18:B18").Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A20").Select
ActiveCell.FormulaR1C1 = "Total Visa, MasterCard, Discover Charges"
Range("A21").Select
ActiveCell.FormulaR1C1 = "Less: Total Fees"
Range("A22").Select
ActiveCell.FormulaR1C1 = "Total Amount Owed"
Range("A23").Select
ActiveCell.FormulaR1C1 = "Total ACH Payments"
Range("A24").Select
ActiveCell.FormulaR1C1 = "Overpaid (UnderPaid)"
Range("A24:B24").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A22:B22").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A20:B20").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A20:B20,A22:B22,A24:B24").Select
Range("A24").Activate
Selection.Font.Bold = True
Cells.Select
Cells.EntireColumn.AutoFit
Range("B2:B24").Select
Selection.Style = "Currency"
Range("B2").Select
ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 2).Value
Range("B3").Select
ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 4).Value
Range("B4").Select
ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 5).Value
Range("B5").Select
ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 3).Value
Range("B6").Select
ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 6).Value
Sheets("Daily Summary").Select
Columns("G:G").Select
Selection.Cut
Columns("O:O").Select
Selection.Insert Shift:=xlToRight
Sheets("Summary").Select
Range("B8").Select
ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 10).Value
Range("B9").Select
ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 7).Value
Range("B10").Select
ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 8).Value
Range("B11").Select
ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 9).Value
Range("B12").Select
ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 11).Value
Range("B14").Select
ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 12).Value
Range("B15").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("B17").Select
ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 13).Value
Range("B18").Select
ActiveCell.FormulaR1C1 = "=R[-1]C"
Range("B20").Select
ActiveCell.FormulaR1C1 = "=R[-17]C+R[-16]C+R[-15]C"
Range("B21").Select
ActiveCell.FormulaR1C1 = "=R[-9]C+R[-6]C+R[-3]C"
Range("B22").Select
ActiveCell.FormulaR1C1 = "=R[-2]C-R[-1]C"
Range("B22").Select
ActiveCell.FormulaR1C1 = "=R[-2]C-R[-1]C"
Range("B21").Select
ActiveCell.FormulaR1C1 = "=R[-9]C+R[-6]C+R[-3]C"
Range("B23").Select
ActiveCell.FormulaR1C1 = Sheets("Daily Summary").Cells(rowEnd, 16).Value
Range("B24").Select
ActiveCell.FormulaR1C1 = "=R[-2]C-R[-1]C"
Range("B25").Select
ActiveWorkbook.Close
rowStart = x
Sheets("Data").Activate
End If
Next
End Sub
Upvotes: 0
Views: 1164
Reputation: 11
Here's what I think you're looking for. This will loop through (currently) column A and look for if the cell is the same as the one above it. If it is, it will skip to the next row and continue looking.
When it comes across a change in cells, it will then copy from the start of the range to the end and paste it into a new workbook. It currently names the book whatever the cell value is. So it will, in theory, name it the company name.
Sub copyStuff()
Dim rowStart As Integer
Dim rowEnd As Integer
Dim rowMax As Integer
Dim colMax As Integer
Dim bookName As String
Dim thisWB As String
thisWB = ThisWorkbook.Name
rowMax = ActiveSheet.UsedRange.Rows.Count + 1
colMax = ActiveSheet.UsedRange.Columns.Count
rowStart = 2
For x = 3 To rowMax
If Cells(x, 1) = Cells(x - 1, 1) Then
'
Else
rowEnd = x - 1
bookName = Cells(rowEnd, 1).Value
Range(Cells(rowStart, 1), Cells(rowEnd, colMax)).Copy
Set NewBook = Workbooks.Add
Range("A2").PasteSpecial (xlPasteValues)
NewBook.SaveAs Filename:=bookName
Workbooks(thisWB).Activate
Range(Cells(1, 1), Cells(1, colMax)).Copy
Workbooks(bookName).Activate
Range("A1").PasteSpecial (xlPasteValues)
ActiveWorkbook.Save
ActiveWorkbook.Close
rowStart = x
Sheets("Data").Activate
End If
Next
End Sub
Upvotes: 1