[VBA] Autofill selected cells

[Alexlin]

Hi guys, I’ve encountered a difficult task.
There are two sheets (“sheet1” and “sheet2”)
In sheet1, Column A1:A100 are filled with 5 names (some are blank cells)

In sheet2, there are some cells required to be filled in (I.e.,A13, B23, C18, D50, E5). The value to be filled are exactly the five names from sheet1.

What should the VBA be composed so that no matter how the five names located in different row, they would still automatically be filled into those five no-pattern cells in sheet2?

Thanks a lot!

 

[mumps]

Try:

Sub FillCells()
    Application.ScreenUpdating = False
    Dim rng As Range, rngUniques As Range, sVal As String, splitVal As Variant
    Sheets("Sheet1").Range("A1:A100").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Set rngUniques = Sheets("Sheet1").Range("A2:A100").SpecialCells(xlCellTypeVisible)
    Sheets("Sheet1").Range("A1").AutoFilter
    For Each rng In rngUniques
        sVal = sVal & "," & rng.Value
    Next rng
    splitVal = Split(sVal, ",")
    Sheets("Sheet2").Range("A13") = splitVal(1)
    Sheets("Sheet2").Range("B23") = splitVal(2)
    Sheets("Sheet2").Range("C18") = splitVal(3)
    Sheets("Sheet2").Range("D50") = splitVal(4)
    Sheets("Sheet2").Range("E5") = splitVal(5)
    Sheets("Sheet1").Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[Alexlin]

Try:

Sub FillCells()
    Application.ScreenUpdating = False
    Dim rng As Range, rngUniques As Range, sVal As String, splitVal As Variant
    Sheets("Sheet1").Range("A1:A100").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Set rngUniques = Sheets("Sheet1").Range("A2:A100").SpecialCells(xlCellTypeVisible)
    Sheets("Sheet1").Range("A1").AutoFilter
    For Each rng In rngUniques
        sVal = sVal & "," & rng.Value
    Next rng
    splitVal = Split(sVal, ",")
    Sheets("Sheet2").Range("A13") = splitVal(1)
    Sheets("Sheet2").Range("B23") = splitVal(2)
    Sheets("Sheet2").Range("C18") = splitVal(3)
    Sheets("Sheet2").Range("D50") = splitVal(4)
    Sheets("Sheet2").Range("E5") = splitVal(5)
    Sheets("Sheet1").Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

Thanks mumps! It works like magic!
how does it work actually? Mind to share the purpose of each sentence??
Im still very new to VBA

 

[mumps]

You are very welcome. Here is the macro with explanatory comments. I hope this helps.

Sub FillCells()
    Application.ScreenUpdating = False 'turns off screen refreshing to avoid flicker and speed up the macro
    Dim rng As Range, rngUniques As Range, sVal As String, splitVal As Variant
    Sheets("Sheet1").Range("A1:A100").AdvancedFilter Action:=xlFilterInPlace, Unique:=True 'filters column A for unique values
    Set rngUniques = Sheets("Sheet1").Range("A2:A100").SpecialCells(xlCellTypeVisible) 'sets the variable 'rngUniques' to hold the unique values
    Sheets("Sheet1").Range("A1").AutoFilter 'removes the autofilter
    For Each rng In rngUniques 'loops through the list of unique values
        sVal = sVal & "," & rng.Value 'joins all the unique values into one string separated by commas
    Next rng
    splitVal = Split(sVal, ",") 'splits the variable sVal into individual unique names
    Sheets("Sheet2").Range("A13") = splitVal(1) 'The index number of the first individual unique name in splitVal is 0.  Since this would be equal to
    Sheets("Sheet2").Range("B23") = splitVal(2) 'the blank space in column A, we don't use the 0. We therefore use the values 1 to 5 to represent the
    Sheets("Sheet2").Range("C18") = splitVal(3) 'next 5 unique names and assign each to the appropriate cell in Sheet2.
    Sheets("Sheet2").Range("D50") = splitVal(4)
    Sheets("Sheet2").Range("E5") = splitVal(5)
    Sheets("Sheet1").Range("A1").AutoFilter
    Application.ScreenUpdating = True 'turns screen refreshing back on
End Sub

 

[Alexlin]

You are very welcome. Here is the macro with explanatory comments. I hope this helps.

Sub FillCells()
    Application.ScreenUpdating = False 'turns off screen refreshing to avoid flicker and speed up the macro
    Dim rng As Range, rngUniques As Range, sVal As String, splitVal As Variant
    Sheets("Sheet1").Range("A1:A100").AdvancedFilter Action:=xlFilterInPlace, Unique:=True 'filters column A for unique values
    Set rngUniques = Sheets("Sheet1").Range("A2:A100").SpecialCells(xlCellTypeVisible) 'sets the variable 'rngUniques' to hold the unique values
    Sheets("Sheet1").Range("A1").AutoFilter 'removes the autofilter
    For Each rng In rngUniques 'loops through the list of unique values
        sVal = sVal & "," & rng.Value 'joins all the unique values into one string separated by commas
    Next rng
    splitVal = Split(sVal, ",") 'splits the variable sVal into individual unique names
    Sheets("Sheet2").Range("A13") = splitVal(1) 'The index number of the first individual unique name in splitVal is 0.  Since this would be equal to
    Sheets("Sheet2").Range("B23") = splitVal(2) 'the blank space in column A, we don't use the 0. We therefore use the values 1 to 5 to represent the
    Sheets("Sheet2").Range("C18") = splitVal(3) 'next 5 unique names and assign each to the appropriate cell in Sheet2.
    Sheets("Sheet2").Range("D50") = splitVal(4)
    Sheets("Sheet2").Range("E5") = splitVal(5)
    Sheets("Sheet1").Range("A1").AutoFilter
    Application.ScreenUpdating = True 'turns screen refreshing back on
End Sub

Thanks Mumps! It helps a lot. I found that the code doesnt work for the name iteself with ",", (such as (Range ("A2") = Mary, Tom and Peter Fund)
I try to fix it with changing the "," to split of unique name, but it doesnt work at all.
How could fix this problem?
Highly appreciated!! Thanks

 

[mumps]

Are you saying that cells in column A have more than one name? I think that it would be easier to help and test possible solutions if I could work with your actual file which includes any macros you are currently using. Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do using a few examples from your data and referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data.

 

[Alexlin]

Are you saying that cells in column A have more than one name? I think that it would be easier to help and test possible solutions if I could work with your actual file which includes any macros you are currently using. Perhaps you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do using a few examples from your data and referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data.

My apologis that I cant share the files online due to confidentiality issue (I work in compliance sector).
The difficulty is very obvious. Once there is a comma in any cell under column A, the result wont be correct.

The situation is similar to the below. A1~A9 are cells on sheet1 under column A.

A1 = Name
A2 = Tom
A3 = Peter
A4 = (Blank)
A5 = (Blank)
A6 = May, Wong & Sam Partnership
A7 = (Blank)
A8 = S/N/O cherry, George fund adminstrator
A9 = William

Then I run your macro formula...(Tom, Peter, William) were shown correctly on sheet 2, but "May, Wong & Sam Partnership" is shown seperately into two cells, "Wong & Sam Partnership" in sheet2.range("E15") and "May" in sheet2.range("D50")
"S/N/O cherry, George fund adminstrator" is not shown on sheet2.

Plz lemme know if u still wanna see the original file. Much appreciated at ur helpfulness!

 

[mumps]

Simply replace the 2 occurrences of the comma in the code with another character that you are sure will not be in any cell in column A, an exclamation mark, for example.

 

[Alexlin]

Simply replace the 2 occurrences of the comma in the code with another character that you are sure will not be in any cell in column A, an exclamation mark, for example.

Hey mumps! sorry fo the late follow-up! a bit busy recently
finally the problem is fixed as you suggested, but another problem occurs.
Hard to explain here, so i just upload the file dropbox for your handling.

The relvant module is module 2 with the formula u provided and I have made a few modifications.
The data flows from the sheets("data input") collumn A to the sheets("E&P Allocation) collumn D.(Actually cells in collumn D have a pattern, each cells plus 44 is another cell to be filled in...for example, D14-->D58-->D102...etc., but I dunno how to combine for...Next stmt with your formula)

The problem is...all cells are filled correctly, Except D102, which is blank.

https://www.dropbox.com/s/qporjr6qs0okq61/Online Checking.xlsm?dl=0

Thanks ahead of your help!

 

[mumps]

Try this macro. It will also automatically adjust if the number of names in column A changes.

Sub FillCells()
    Application.ScreenUpdating = False
    Dim Rng As Range, lastRow As Long, sVal As String, Key As Variant, RngList As Object, x As Long, y As Long
    y = 1
    lastRow = Sheets("E&P Allocation").Range("A" & Sheets("Data Input").Rows.Count).End(xlUp).Row
    Set RngList = CreateObject("Scripting.Dictionary")
    For Each Rng In Sheets("Data Input").Range("A20:A" & lastRow)
        If Rng <> "" Then
            If Not RngList.Exists(Rng.Value) Then
                RngList.Add Rng.Value, Nothing
            End If
        End If
    Next Rng
    For Each Key In RngList.keys
        sVal = sVal & "!" & Key
    Next Key
    splitVal = Split(sVal, "!")
    With Sheets("E&P Allocation")
        For x = 14 To lastRow Step 44
            .Range("D" & x) = splitVal(y)
            y = y + 1
            If y > UBound(splitVal) Then Exit For
        Next x
    End With
    Sheets("Data Input").Range("A19").AutoFilter
    Application.ScreenUpdating = True
End Sub