My code keeps giving me only results for Sheet1.Cells(3, 1). It outputs to the correct cells using sequential i's but always from the same input in (3,1). How can I get it to loop through the inputs of the first column (3,1), (4,1) (5,1) etc.?
Sub CorrectName()
Dim IndexAnswers() As String
Dim FirstLastName As String
Dim FirstLastNameSplit() As String
i = 3
While Sheet1.Cells(i, 1) <> ""
IndexAnswers() = Split(Sheet1.Cells(i, 1), ";")
For k = 0 To UBound(IndexAnswers)
If IndexAnswers(k) = "" Then IndexAnswers(k) = ","
If k > 107 And k < 132 Then
FirstLastName = FirstLastName & IndexAnswers(k)
End If
Next
FirstLastNameSplit() = Split(FirstLastName, ",")
Sheet1.Cells(i, 4) = FirstLastNameSplit(0)
Sheet1.Cells(i, 3) = FirstLastNameSplit(1) & FirstLastNameSplit(2)
i = i + 1
Wend
End Sub
Related
I am attempting to loop through a column. If the the item in the column matches the next item in the column. If they are the same, I will take values associated with the first row item and append it with stuff from the lines below.
I have tried using nested if loops to loop through a column. Ignore some of the functionality my code, but I am not sure why my comparisons are not working.
For bigLoop = 1 To Length + 1
firstString = Workbooks("VBA_Basics.xlsm").Worksheets("TestSheet").Cells(bigLoop, 24).Value
Cells(bigLoop, 28).Value = Cells(bigLoop, 26)
Debug.Print firstString
For smallLoop = 1 To Length + 1
secondString = Workbooks("VBA_Basics.xlsm").Worksheets("TestSheet").Cells(smallLoop + 1, 4).Value
Debug.Print secondString
myComp = StrComp(firstString, secondString, vbBinaryCompare)
If myComp = 0 Then
Cells(bigLoop, 28).Value = Cells(bigLoop, 26).Value & " :) " & Cells(smallLoop + 1, 26).Value
End If
Debug.Print myComp
Next smallLoop
Next bigLoop
Please sort your column! Then try this:
Option Explicit
Option Base 1
Private Const NITEMS As Integer = 11
' Column "A"
Private Const COLUMN As Integer = 1
' Column "B"
Private Const TARGET_COLUMN As Integer = 2
' Please sort your column!
Public Sub X()
Dim I As Integer
Dim J As Integer
Dim V1 As Variant
Dim V2 As Variant
I = 1
While I <= NITEMS
V1 = ActiveSheet.Cells(I, COLUMN).Value
ActiveSheet.Cells(I, TARGET_COLUMN).Value = V1
J = I + 1
V2 = ActiveSheet.Cells(J, COLUMN).Value
While V1 = V2 And J <= NITEMS
ActiveSheet.Cells(I, TARGET_COLUMN).Value = _
ActiveSheet.Cells(I, TARGET_COLUMN).Value & " :) " & V2
J = J + 1
V2 = ActiveSheet.Cells(J, COLUMN).Value
Wend
I = J
Wend
End Sub
I am slowly learning how to do some very basic routines in Excel VBA, but I dont know how to tackle this one.
How can I go from data in one row looking like this :
11-Jun,27.3,28.3,12-Jun,27.2,28.3,13-Jun,26.7,28.4,14-Jun,26.7,28.4
to 3 columns.
First column with date, 2nd with first value, 3rd with the second value ?
Thanks
Put your data in A1.
This will loop the data back to the desired column based on if there is a remainder left after dividing.
Option Explicit
Sub splitData()
Dim i, rownum, colnum As Integer
Dim str As Variant
colnum = 1
rownum = 2
str = Split(Cells(1, 1).Value, ",")
For i = 0 To UBound(str)
If i Mod 3 = 2 Then
Cells(rownum, 3).Value = "'" & str(i)
End If
If i Mod 3 = 1 Then
Cells(rownum, 2).Value = "'" & str(i)
End If
If i Mod 3 = 0 Then
rownum = rownum + 1
Cells(rownum, 1).Value = "'" & str(i)
End If
Next i
End Sub
Or maybe something like this :
Sub test()
x = Split(Range("A1"), ",")
y = (UBound(x) + 1) / 3
P = 1
For i = 1 To y
For Z = 1 To 3
Cells(i + 3, Z).Value = x(P - 1)
P = P + 1
Next
Next
End Sub
I'd like to concatenate the number of days that add up to 80%. Please see the example below;
I can run a code that concatenates Range A1:A7 and the result is printed in C1;
Sub Concatenator()
Dim lastLng As Long
Dim result As String
Dim delim As String
Dim b As String
delim = "&"
lastLng = Worksheets("Sheet1").Range("A1048576").End(xlUp).Row
For i = 1 To lastLng
b = Cells(i, 1).Value
result = result & b & delim
Next
result = Left(result, Len(result) - Len(delim))
Worksheets("Sheet1").Cells(1, 3).Value = result
End Sub
I'd to add a "Do Until" loop that loops until the value in column is greater than 80%. I've tried to amend the code above with the "Do Until" loop;
Sub Concatenator()
Dim lastLng As Long
Dim result As String
Dim delim As String
Dim b As String
delim = "&"
lastLng = Worksheets("Sheet1").Range("A1048576").End(xlUp).Row
Do Until Cells(i, 2).Value = ">80%"
For i = 1 To lastLng1
b = Cells(i, 1).Value
result = result & b & delim
Next
Loop
result = Left(result, Len(result) - Len(delim))
Worksheets("Sheet1").Cells(1, 3).Value = result
End Sub
As far as I understand this might work for you
To understand how to set up the code, take a look For-Loop and Do-while, then combine the conditions with the loop as the following code
i = 1
Do Until Cells(i, 2).Value = 0.8 'Loop until request condition
If i > lastLng1 Then Exit Do 'Loop until end of the range
b = Cells(i, 1).Value
result = result & b & delim
i = i + 1
Loop
'Or------------------------------
For i = 1 To lastLng1 'Loop until end of the range
If Cells(i, 2).Value = 0.8 Then Exit For 'Loop until request condition
b = Cells(i, 1).Value
result = result & b & delim
Next
This is what worked for me
Sub Concatenator()
Dim lastLng As Long
Dim result As String
Dim delim As String
Dim b As String
delim = "&"
lastLng = Worksheets("Sheet1").Range("A1048576").End(xlUp).Row
For i = 1 To lastLng
If Cells(i, 2).Value > "80" Then Exit For
b = Cells(i, 1).Value
result = result & b & delim
Next
result = Left(result, Len(result) - Len(delim))
Worksheets("Sheet1").Cells(1, 3).Value = result
End Sub
I changed the value in column be from a percentage to a number. I also removed the equal sign
For i = 1 To lastLng
If Cells(i, 2).Value > "80" Then Exit For
b = Cells(i, 1).Value
result = result & b & delim
Next
This will work very well for me for now. Thank you #The GridLock
I have this code that looks at column A and loops through to create an array to paste to another destination, but I want to manipulate it to loop through sets of 250 cells and create a concatenated array and print it to cells B1. After that set of 250, I go cells a251-a501, and so forth until I reach the end of the list and have each set of 250 concatenated ID's (separated by a ";") to print to the next destination row (B1>B2>B3, etc..)
Sub JC_Fill()
Dim varArray() As Variant
Dim x As Long, i As Long
i = 0
x = 1
With ThisWorkbook.Worksheets("Sheet1").UsedRange.Rows.Count
ReDim varArray(1) 'resize array
Do Until Cells(x, 1).Value = ""
If Cells(x, 1) <> "" Then
varArray(i) = Cells(x, 1).Value
i = i + 1
ReDim Preserve varArray(i)
End If
x = x + 1
Loop
ReDim Preserve varArray(i - 1)
End With
ThisWorkbook.Worksheets("Sheet1").Range("B1").Value = varArray
End Sub
How could I edit my Do While/Loop to repeat the process every 250 cells and then concatenate the array to one cell separated by ; and then offset the next batch until I have no more ID's to cycle through?
Try changing your code this way:
Sub JC_Fill()
Dim OutString
Dim x As Long, i As Long
Dim out_row As Long
i = 0
x = 1
out_row = 1
With ThisWorkbook.Worksheets("Sheet1").UsedRange.Rows.Count
OutString = ""
Do Until Cells(x, 1).Value = ""
If Cells(x, 1) <> "" Then
If (x > 1) Then OutString = OutString & ";"
OutString = OutString & Cells(x, 1).Value
End If
If (x Mod 250) = 0 Then
ThisWorkbook.Worksheets("Sheet1").Range("B" & out_row).Value = OutString
OutString = ""
out_row = out_row + 1
End If
x = x + 1
Loop
End With
ThisWorkbook.Worksheets("Sheet1").Range("B" & out_row).Value = OutString
End Sub
For interest, you can do this without looping each of the 250 cells.
Sub x()
Dim n As Long, v As Variant, r As Range, n2 As Long
n = 5 '250 for you
n2 = Range("A" & Rows.Count).End(xlUp).Row
Set r = Range("A1").Resize(n)
Do While Len(r(1)) > 0
If n2 - r(1).Row < n Then Set r = r.Resize(n2 - r(1).Row + 1)
If r.Count = 1 Then
v = r.Value
Else
v = Join(Application.Transpose(r), ";")
End If
Range("B" & Rows.Count).End(xlUp)(2).Value = v
Set r = r.Offset(n)
Loop
End Sub
I have the following Excel sheet which has random number combinations build using numbers from 2 to 50 in set of 3, 2 and 1 in Column A.
I am trying to build whole possible combinations between Column A elements such that the obtained combination doesn't have any repeating numbers in them and contains all the number from 2 to 50.
My current code starts from A2 and builds only a single combination set. It doesn't evaluate other possible combinations with starting element as in A2, it then goes to A3 and then builds only one combination set using A3. This step continues for A4,A5...
This is my current code.
Private Sub RP()
Dim lRowCount As Long
Dim temp As String, s As String
Dim arrLength As Long
Dim hasElement As Boolean
Dim plans() As String, currentPlan() As String
Dim locationCount As Long
Dim currentRoutes As String
Dim line As Long
Worksheets("Sheet1").Activate
Application.ActiveSheet.UsedRange
lRowCount = ActiveSheet.UsedRange.Rows.Count
locationCount = -1
line = 2
Debug.Print ("*********")
For K = 2 To lRowCount - 1
currentRoutes = ""
For i = K To lRowCount
s = ActiveSheet.Cells(i, 1)
Do
temp = s
s = Replace(s, " ", "")
Loop Until temp = s
currentPlan = Split(Trim(s), ",")
arrLength = UBound(currentPlan) - LBound(currentPlan) + 1
hasElement = False
If Len(Join(plans)) > 0 Then
For j = 0 To arrLength - 1
pos = Application.Match(currentPlan(j), plans, False)
If Not IsError(pos) Then
hasElement = True
Exit For
End If
Next j
End If
If Not hasElement Then
currentRoutes = currentRoutes & (Join(currentPlan, ",")) & " "
If Len(Join(plans)) > 0 Then
plans = Split(Join(plans, ",") & "," & Join(currentPlan, ","), ",")
Else
plans = currentPlan
End If
End If
Next i
If locationCount < 0 Then
locationCount = UBound(plans) - LBound(plans) + 1
End If
If (UBound(plans) - LBound(plans) + 1) < locationCount Then
Debug.Print ("Invalid selection")
Else
Debug.Print (Trim(currentRoutes))
Worksheets("Sheet1").Cells(line, 11) = currentRoutes
line = line + 1
End If
Erase plans
Debug.Print ("*********")
Next K
End Sub