Concatenate Strings with Do Loop with dynamic column and files - vba

Question

So at Assign sheet I indicate the sheets to take data for each group (each for column and the first row is the explanation of the group). I dynamically can add res at the file or delete
After I use predefined codes to assign which type of discounts / day are applied. At the example I only put two codes (C and S) and one week. For example the raw sheet data for designations Red and Black.
Data product worksheet
Then at Diary I want to show the result of concatenate the B1 value (name of product) each time code fromm price are indicated into the rows. Also I use two loop because at raw product data I have one column for price but at the Diary I have two
Summary page
This is what I finally want to get and doing like that because my boss don't know anything for code and he wan't edite it so I try to do ll dynamic at the sheets :) [I only put two images because i don't have reputations point enough to put more]
With the formula I only get FALSE as answer :(, and I need to get what you can see at summary page
Sub Diary()
Dim I As Integer, x As Integer, y As Integer, z As Integer, n As Integer
Dim p As Integer, d As Integer, f As Integer
Dim a As String, b As String
Dim element As Variant
' Initialize variables I and y at 3 and 4 to begin to show the data at the column I desire. Also x and z were intended to pass the one column mode data sheet to the two column mode at the summary page.
I = 3
x = 1
y = 4
z = 0
With Worksheets("Asign")
.Activate
.Range("B2").Select
End With
' Set the size of Data with sheet names it get form the page assign. It can dynamically changed as size as names of sheets
With ActiveSheet
r = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Dim Data() As String
ReDim Data(r)
For p = 1 To r - 1
Data(p) = ActiveSheet.Cells(p + 1, "B").Value
Next p
With Worksheets("Diary")
.Activate
.Range("C7").Select
End With
' At Diary concatenate the same cell for all the sheets I have his name stored at Data() and then pass to the next cell with data at raw data sheets (in the images (Red, Black ,... pages). In this case search for code S
Do
Cells(7, I).Select
ActiveCell.Value = ActiveCell.FormulaR1C1 = "=CONCATENATE(" & a & ")"
For Each element In Data
b = ActiveCell.FormulaR1C1 = "IF(Data& !R[-2]C[" & x & "]=""S"",CONCATENATE(Data&!R1C2,"", ""),"""")"
a = b & ";" & b
Next element
x = x - 1
I = I + 2
Loop While I < 4
' The same for the second column of summary sheet called Diary. In this case search for code C
Do
Cells(7, y).Select
ActiveCell.Value = ActiveCell.FormulaR1C1 = _
"=CONCATENATE(" & a & ")"
For Each element In Data
b = ActiveCell.FormulaR1C1 = "IF(Data& !R[-2]C[" & z & "]=""S"",CONCATENATE(Data&!R1C2,"", ""),"""")"
a = b & ";" & b
Next element
z = z - 1
y = y + 2
Loop While I < 4
' Drag and Drop the formula to all the sheet's cells you need
Range("C8:E8").Select
Selection.AutoFill Destination:=Range("C8:E10"), Type:=xlFillDefault
'
End Sub

Answer 1

try this. .... could be simplified by looping through "colors" .... black, red, etc
Sub Diary()
Dim red As Variant
red = Sheets("red").Range("d6:g12") ' put range data into an array for processing
Dim black As Variant
black = Sheets("black").Range("d6:g12")
Dim i As Integer
Dim j As Integer
Dim strC As String
Dim strS As String
For i = 1 To 7
For j = 1 To 4
strC = ""
strS = ""
If LCase(black(i, j)) = "c" Then strC = "Black"
If LCase(black(i, j)) = "s" Then strS = "Black"
If LCase(red(i, j)) = "c" Then
If Len(strC) > 1 Then strC = strC & ";"
strC = strC & "Red"
End If
If LCase(red(i, j)) = "s" Then
If Len(strS) > 1 Then strS = strS & ";"
strS = strS & "Red"
End If
Sheets("diary").Range("c7").Cells(i, j * 2 - 1) = strS
Sheets("diary").Range("c7").Cells(i, j * 2) = strC
Next j
Next i
End Sub