VBA Conditional loop

[ana_c]

Hello,



I'm trying to automate a Boolean process on Excel and was hoping to get some help with the loop/vba logic.



Column A contains integers that range between 1-4.

I would like to create 4 columns on the side (since "A" contains 4 possible values) which have the following logic:

If cell A2=2, B2=0, C2=1,D2=0, E2=0.

Similarly if A3=4, B2=0, C2=0, D2=0, E2=1.



So essentially I'd like to create a binary string in columns B, C, D and E based on the value in A.

I would like to do this for the entire column A



I want to be able to do this with a macro as I have many such columns (as "A) that I wish to automate and transform into binary columns (as B, C, D and E)



Please note that of all the columns I have, the value ranges are different, i.e. not all columns range from 1-4.. some of them are 1-2 and some are 1-10 but they are always integers. So the number of columns to create next to each principal column (from this example, principal column = A), will be equal to the max value of the principal column.



Thanks in advance for your help

Ana

 

[Joe4]

Welcome to the Board!

So, your original data is only in one column, column A, right?

And you say that the number of columns that you need to populate may not be 4, it could be some other number.
What determines exactly what this number should be?
Should we just scan column A for the largest value?
And then should EVERY single row go out as far as this number?

 

[Joe4]

If my above assumptions are correct, try this:

Sub MyMacro()

    Dim lr As Long
    Dim mx As Long
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Find largest value in column A
    mx = Application.WorksheetFunction.Max(Range("A2:A" & lr))
    
'   Populate formulas
    Range(Cells(2, "B"), Cells(lr, mx + 1)).FormulaR1C1 = "=IF(COLUMN()-1=RC1,1,0)"
    
End Sub

 

[ana_c]

Thanks for your reply.

Please see my answers to your question below -

So, your original data is only in one column, column A, right?
Yes, that's correct. But we will have multiple "main columns". I have attached a screenshot to show you what I mean and what I want the Boolean columns to look like

And you say that the number of columns that you need to populate may not be 4, it could be some other number.
What determines exactly what this number should be?
The max value that is in the main column. i.e. if the largest number in the main column is 7, then we would need to create 7 columns

Should we just scan column A for the largest value?
Yes, that's correct

And then should EVERY single row go out as far as this number?
Yes, also correct

 

[Joe4]

So, your original data is only in one column, column A, right?
Yes, that's correct. But we will have multiple "main columns". I have attached a screenshot to show you what I mean and what I want the Boolean columns to look like

This requirement needs to be defined better.
Since the number of columns after the first main column is dependent upon the maximum value in column A, how do we know where this second "main" column will reside?
Can you show us a picture of what the data might look like (in its original state) BEFORE you do anything at all?

And how many of these "main" columns might you have?

 

[ana_c]

Hi,

Thanks for your questions.
The original state has all the main columns side by side - something like this

Maybe the way to go is to make the macro create the additional columns for each "main column" on a new sheet?- this way we can probably achieve the layout in my first picture (From the previous message).

And how many of these "main" columns might you have?
This would vary - but it's usually around 20-30

Hope this makes sense

 

[Joe4]

Try the following:

Sub MyMacro()

    Dim n As Long
    Dim lc As Long, c As Long
    Dim rng As Range
    Dim lr As Long
    Dim mx As Long
   
    Application.ScreenUpdating = False
   
'   Find last column in row 1 with data
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
   
'   Initalize column value
    c = 1
   
'   Loop through each principal column
    For n = 1 To lc
'       Find largest row with data in column
        lr = Cells(Rows.Count, c).End(xlUp).Row
'       Build column range
        Set rng = Range(Cells(2, c), Cells(lr, c))
'       Find largest value in column
        mx = Application.WorksheetFunction.Max(rng)
'       Insert appropriate number of columns
        Range(Cells(1, c + 1), Cells(1, c + mx)).EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'       Insert formulas
        Range(Cells(2, c + 1), Cells(lr, c + mx)).FormulaR1C1 = "=IF(COLUMN()-" & c & "=RC" & c & ",1,0)"
'       Increment c for next set
        c = c + mx + 1
    Next n
   
    Application.ScreenUpdating = True
   
End Sub

 

[ana_c]

You're a star Joe!
Many thanks, this works brilliantly

 

[Joe4]

You are welcome.
Glad it works for you!

 

[ana_c]

Hi Joe,
I have another quick question.

Can you help me modify the code such that if the highest value in the main column is 1, we don't create an extra column as this is already binary.
Thanks in advance