Copying multiple cells in same row based on multiple criteria

Question

Background: I have an Excel file used for tracking credit card payables. There are 18 columns of data (A through R). Out of these 18 columns, I want to use a macro to filter for specific statement date and then for a specific company code.

Each company code will be assigned a new worksheet. In each of these worksheets, I want to bring over specific cells from the master worksheet based on the criteria. For instance, the macro should first sort for statement date (7/31/2012) and then company code (ABC). Then, I need to run a loop to bring over details. For instance, in the master worksheet, the GL code in column P needs to be copied to the "ABC" worksheet in column H.

Here's a summary of what needs to happen:
1. Clear any filters in filter range (A2:R2)
2. Filter for date in cell A1 on "Master" worksheet beginning in cell A3 (date column)
3. Filter for company code (ABC) in column O

That should give a data set for particular company's statement activity. Here's what needs to happen next:
4. Copy Column P cell values in "master" worksheet to Column C in "ABC" worksheet
5. Copy Column N cell values in "master" worksheet to Column D in "ABC" worksheet
6. Copy Column R cell values in "master" worksheet to Column H in "ABC" worksheet
7. Copy Column F cell values in "master" worksheet to Column G in "ABC" worksheet, but max of 30 characters
8. If Column G value in "master" worksheet is >=0, then copy that value to Column E in "ABC" worksheet (otherwise needs to be zero)
9. If column G value in "master" worksheet is <0, then copy that value to Column F in "ABC" worksheet (otherwise needs to be zero)

Is this possible?

To answer your question, yes this is definitely possible. What methods have you tried thus far that you are having difficulties with? — Gaffi
I'm very new to programming so not much has been tried and I've had difficulty stitching together basic solutions (for instance, i can copy, but not able to copy from filter, etc) — user1556069
Are you able to complete steps 1-3? To answer your question from the last comment, use ActiveSheet.Cells.SpecialCells(xlCellTypeVisible).Select to get only the cells that are not filtered. More generally, if you have any code that you have already created, please add it to the body of the question so we can guide you more directly. If you do not have any code so far, I or someone else may be able to produce a function like this for you, but you'll probably need to be willing to make some of your own modifications/tweaks. — Gaffi
I don't trust any of my code! (It was all based on manual entry within the body of the code, too). If you can point me in right direction, I'll definitely work on modifying as necessary. Again, I appreciate your feedback and help on this. — user1556069
I am willing to help, but will need some time to complete this for you. Unless someone gets to it first, I will try to get something up within the next 24-48 hours. — Gaffi

Gaffi Gaffi · Accepted Answer · 2012-07-28T06:06:54

Here's a sub that should get you started. I did not implement all your steps, but I believe this is enough to take and finish on your own. If you find this answer is helpful to get you where you need to go, please accept this answer. If you have problems with anything here, please add a comment to this answer asking for clarification.

I have only tested on dummy data, but what I did work with was successful.

Option Explicit

Sub TransferData()
Dim Master As Worksheet
Dim NewSheet As Worksheet
Dim CompanyList As Object
Dim lRow As Long, lMaxRow As Long, lNewRow As Long
Dim vDictItem As Variant

Set CompanyList = CreateObject("Scripting.Dictionary")

Set Master = ThisWorkbook.Sheets("Master")

If Master.FilterMode Then
    Master.ShowAllData
End If

Master.Range("A:R").Sort Master.Range("A2"), xlAscending, Master.Range("O2"), , xlAscending, , , xlYes

lMaxRow = Master.Range("A" & Master.Rows.Count).End(xlUp).Row
For lRow = 3 To lMaxRow
    If Not CompanyList.Exists(Master.Range("A" & lRow).Value) Then
        CompanyList.Add Master.Range("A" & lRow).Value, Master.Range("A" & lRow).Value
    End If
Next lRow

For Each vDictItem In CompanyList.Keys
    Master.Range("A3:R" & lMaxRow).AutoFilter 1, vDictItem
    If Master.Cells.SpecialCells(xlCellTypeVisible).Count > 0 Then
        Set NewSheet = ThisWorkbook.Worksheets.Add
        NewSheet.Name = vDictItem
        lNewRow = 1
        For lRow = 3 To lMaxRow
            If Master.Rows(lRow).Hidden = False Then
                lNewRow = lNewRow + 1
                NewSheet.Range("C1").Value = Master.Range("P1").Value
                NewSheet.Range("C" & lNewRow).Value = Master.Range("P" & lRow).Value
                NewSheet.Range("G1").Value = Master.Range("F1").Value
                NewSheet.Range("G" & lNewRow).Value = Left(Master.Range("F" & lRow).Value, 30)
                NewSheet.Range("E1").Value = Master.Range("G1").Value & " (POS)"
                NewSheet.Range("F1").Value = Master.Range("G1").Value & " (NEG)"
                If Master.Range("G" & lRow).Value >= 0 Then
                    NewSheet.Range("E" & lNewRow).Value = Left(Master.Range("G" & lRow).Value, 30)
                Else
                    NewSheet.Range("F" & lNewRow).Value = Left(Master.Range("G" & lRow).Value, 30)
                End If
            End If
        Next lRow
    End If
Next vDictItem


End Sub

Copying multiple cells in same row based on multiple criteria

1 Answers