user3439693
user3439693

Reputation: 43

VBA - Selecting Data

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

Answers (1)

NeonSharpie
NeonSharpie

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

Related Questions