CODEWITHSUNDEEP
arraysexcelvbaif-statement
André Mora Barreira
André Mora Barreira

Reputation: 39

How can I create an array based in a IF funtion

I'm new at VBA and coding. My problem is as follows: I have an array of data in a spreadsheet conformed by client's names and the day the order product. What I need to do is create a new array, in a different spreadsheet, where I can have every client listed (without repeating) on column A and the associated order date for each client on column B, C an so on. So basically is converting the raw data into useful data. I would really appreciate any type of help!! The VBA looks as follows:

Sub Test_1()
Application.ScreenUpdating = False

' Statment

Dim Client As String
Dim Order_date As Date
Dim Counter As Integer
Dim Data As Worksheet
Dim Data_storage As Worksheet
Dim i As Integer

Counter = 10

' Core
' For every value in column B *This values are going to be clients names * They are going to be repeated value in this column *This data is in the Data spreadsheet

' When the counter begins, if new Client is detected
' Then paste in worksheet Data_storage in column A and paste in column B the Order_date value *Every Client will have a order date associated

' If's a repeated Client, only paste the Order_date value in the next column with no value of the existing Client



End Sub

Upvotes: 0

Views: 77

Answers (1)

user3598756
user3598756

Reputation: 29421

assuming your "source" data:

  • are in column "B"

  • start from row 1, with a "header"

then you can try this code:

Option Explicit

Sub Test_1()
    Dim sourceRng As Range, pasteRng As Range, cell As Range

    Set pasteRng = Worksheets("Data_storage").Range("A1") '<--| set the upper-left cell in "paste" sheet

    With Worksheets("Data") '<--| reference "source" sheet
        Set sourceRng = .Range("C1", .Cells(.Rows.Count, "B").End(xlUp)) '<--| set the "source" range to columns "B:C" from row 1 down to last non empty cell in column "B"
    End With

    With sourceRng '<--| reference "source" range
        .Sort key1:=.Range("A1"), order1:=xlAscending, key2:=.Range("B1"), order2:=xlAscending, header:=xlYes '<--| sort it by its column 1 and then by its column 2
        pasteRng.Resize(.Rows.Count).value = .Resize(, 1).value '<--| paste its column 1 values to "Paste" sheet column 1
        pasteRng.CurrentRegion.RemoveDuplicates Columns:=Array(1) '<--| leave only unique values in "paste" range
        Set pasteRng = pasteRng.Range(pasteRng.Offset(1), pasteRng.End(xlDown)) '<--| skip "paste" range header
        For Each cell In pasteRng '<--| loop through unique values in "paste" range column 1
            .AutoFilter field:=1, Criteria1:=cell.value '<--| filter "source" range column 1 with current unique value
            .Offset(1, 1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Copy '<--| copy "source" range" column 2 filtered cells
            cell.Offset(, 1).PasteSpecial Transpose:=True   '<--| ... and paste/transpose them aside current unique value in "paste" range
        Next cell
        .Parent.AutoFilterMode = False '<--| .. show all rows back...
    End With
End Sub

Upvotes: 1

Related Questions