Trying to convert specific data in a specific column through the whole worksheet.
This is my current code, it does not error out, however it doesn't display the first result correctly (Shows 00:00:00), and only stops at the first record.
Sub CleanEntry()
Dim i As Integer
Dim Seconds As Integer
Dim j As Long
Dim c As Long
j = 2
For i = Sheet1.UsedRange.Rows.Count To 1 Step -1
c = Range("B" & j).Value
c = c / 86400
Range("B" & j).Value = Format(c, "hh:mm:ss")
j = j + 1
Next
End Sub
Though I do not understand why you are using two counters, with one going backwards and the other forward, this can be done with one line:
Sub CleanEntry()
Dim i As Long
Dim j As Long
j = 2
For i = Sheet1.UsedRange.Rows.Count To 1 Step -1
Range("B" & j).Value = Format(TimeSerial(0, 0, Range("B" & j).Value), "hh:mm:ss")
j = j + 1
Next
End Sub
Related
I am writing a script to print in a message box, the cell value and repetitive number counts from 1-5.
Currently, I have a for loop that counts the total number of rows I have in my spreadsheet. I am unsure of how to add another for loop (nested for loop) to call the program to add 1 to 5 to the first 5 rows, and restart at 1 to 5 again at the 6th row, and so on.
For example,
If values in cells A1 to A10 are "Apple" respectively, I want to concetenate numbers from 1 to 5 such that I get the results below:
A1 = "Apple1"
A2 = "Apple2"
A3 = "Apple3"
A4 = "Apple4"
A5 = "Apple5"
A6 = "Apple1" 'it starts from 1 again
A7 = "Apple2"
and so on
Below is my sample code:
Option Explicit
Sub appendCount()
Dim q, i, rowStart, rowEnd , rowNum, LR as Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
rowNum = Range("A1:A" & LR).Count
For q = 1 To rowNum Step 1
If Not IsNull(Range("A" & q)) Then
For i = 1 to 5
MsgBox Range("A" & q).Value & i
Next i
End If
Next q
End Sub
Any help would be greatly appreciated!
I believe the following will do what you expect, it will look at the values on Column A and add the count to them on Column B:
Option Explicit
Sub appendCount()
Dim LR As Long, rownumber As Long, counter As Long
Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
'declare and set the worksheet you are working with, amend as required
counter = 0
LR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For rownumber = 1 To LR Step 1
If Not IsEmpty(ws.Range("A" & rownumber)) Then
counter = counter + 1
If counter = 6 Then counter = 1
ws.Range("B" & rownumber).Value =ws.Range("A" & rownumber).value & counter
End If
Next rownumber
End Sub
IsNull() on a cell will always return False. Replace IsNull by IsEmpty,
or use someCell <> "".
See https://stackoverflow.com/a/2009754/78522
Working with arrays will be faster. Also, mod will fail with large numbers so the below is written to handle large numbers. The point to start renumbering is also put into a constant to allow easy access for changing. Code overall is thus more flexible and resilient.
Option Explicit
Public Sub AddNumbering()
Dim arr(), i As Long, lastRow As Long, index As Long
Const RENUMBER_AT = 6
With ThisWorkbook.Worksheets("Sheet1")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Select Case lastRow
Case 1
ReDim arr(1, 1): arr(1, 1) = .Range("A1").Value
Case Else
arr = .Range("A1:A" & lastRow).Value
End Select
index = 1
For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i, 1) <> vbNullString Then
If i - (CLng(i / RENUMBER_AT) * RENUMBER_AT) <> 0 And i <> 1 Then
index = index + 1
Else
index = 1
End If
arr(i, 1) = arr(i, 1) & CStr(index)
End If
Next
.Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End With
End Sub
I understand your question is values in cells A1 to A10 are "Apple" respectively, you want to content Numbers from 1 to 5, then A6 to A10 content Numbers are also from 1 to 5.
This my test code, you can try it:
Option Explicit
Sub appendCount()
Dim q, i, cou, rowStart, rowEnd, rowNum, LR As Long
LR = Cells(Rows.count, 1).End(xlUp).Row
rowNum = Range("A1:A" & LR).count
cou = 1
For q = 1 To rowNum Step 1
If Not IsNull(Range("A" & q)) Then
For i = 1 To 5
MsgBox Range("A" & q).Value & cou
cou = cou + 1
If cou = 6 Then
cou = 1
End If
Next i
End If
Next q
End Sub
Your declaration is wrong, despite what you might expect these variables are NOT declared as Long but as Variant: q, i, rowStart, rowEnd , rowNum you must include the type for each variable separately.
This code should do the trick for you:
Sub appendCount()
Dim q As Long, LR As Long, rowNum As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
rowNum = Range("A1:A" & LR).Count
For q = 1 To rowNum Step 1
If Not Len(Range("A" & q).Value) = 0 Then
If q Mod 5 = 0 Then
MsgBox Range("A" & q).Value & 5
Else
MsgBox Range("A" & q).Value & (q Mod 5)
End If
End If
Next q
End Sub
Sub appendCount()
Dim q, c, i, rowStart, rowEnd, rowNum, LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
rowNum = Range("A1:A" & LR).Count
c = 1
For q = 1 To rowNum Step 1
If Not IsEmpty(Range("A" & q)) Then
If (c Mod 6) <> 0 Then
Range("B" & q).Value = Range("A" & q).Value & (c Mod 6)
Else
c = c + 1
Range("B" & q).Value = Range("A" & q).Value & (c Mod 6)
End If
End If
c = c + 1
Next q
End Sub
This would do it:
Sub Loops()
Dim i As Long, iMultiples As Long, iMultiple As Long
iMultiples = WorksheetFunction.Ceiling_Math(Cells(Rows.Count, 1).End(xlUp).Row, 5, 0) ' this rounds up to the nearest 5 (giving the number of multiples
For iMultiple = 1 To iMultiples
For i = 1 To 5
If Not IsNull(Range("A" & i).Value) Then Range("A" & i).Value = "Apple" & i 'This can be tweaked as needed
Next
Next
End Sub
I have developed a code like this
For i = 1 To 50
For j = i + 1 To 50
For k = j + 1 To 50
..........................
'Here I have someother code
..........................
Next k
Next j
Next i
So this is a nested for loop. And there are 3 for loops in this code.
Now what I want is, I want to make the number of for loops a variable. For an example I have variable call NumberOfForLoops. So if NumberOfForLoops=3 then there should be 3 for loops. If NumberOfForLoops=8 then there should be 8 for loops. I can't find how to do this.
I think it is better to explain what I was trying to accomplish.
I'm trying to find possible combinations
For 3 combinations I wrote this code
Dim WS_Data As Worksheet
Dim WS_Result As Worksheet
Set WS_Data = Worksheets("Data")
Set WS_Result = Worksheets("Result")
Dim i As Long
Dim j As Long
Dim k As Long
Dim EnteringRow As Long
EnteringRow = 1
For i = 1 To 5
For j = i + 1 To 5
For k = j + 1 To 5
WS_Result.Range("A" & EnteringRow).Value = WS_Data.Range("A" & i).Value
WS_Result.Range("B" & EnteringRow).Value = WS_Data.Range("A" & j).Value
WS_Result.Range("C" & EnteringRow).Value = WS_Data.Range("A" & k).Value
EnteringRow = EnteringRow + 1
Next k
Next j
Next i
It gave me below result
Input and Outcome
But now what I need is I want to make the number of items I select from the list dynamic. According to the anwers I understood that I need to use a recursion concept.
So I modified the code according to h2so4's answer.
This is the modified code
Sub test()
Dim WS_Data As Worksheet
Dim WS_Result As Worksheet
Dim WS_Temp As Worksheet
Set WS_Data = Worksheets("Data")
Set WS_Result = Worksheets("Result")
Set WS_Temp = Worksheets("Temp")
ResultRow = 1
NofL = 3
Nestedloop WS_Data, WS_Result, WS_Temp, ResultRow, NofL, 1, 5, 1
End Sub
Sub Nestedloop(WS_Data, WS_Result, WS_Temp, ResultRow, NofL, jmin, jmax, level)
For j = jmin To jmax
WS_Temp.Cells(1, level) = j
'your code when a value of j is set
If level < NofL Then
Nestedloop WS_Data, WS_Result, WS_Temp, ResultRow, NofL, jmin + 1, jmax, level + 1
Else
'your code when the number of loops is reached
For i = 1 To NofL
WS_Result.Cells(ResultRow, 0 + i).Value = WS_Data.Range("A" & WS_Temp.Cells(1, i).Value).Value
Next i
ResultRow = ResultRow + 1
End If
Next j
End Sub
I used a tempory sheet. This is the result I got.
Result got
Difficult to understand what is wrong.
another proposal with recursive sub that simulates nested loops
Sub test()
NofL = 4
Nestedloop NofL, 1, 50, 1
End Sub
Sub Nestedloop(NofL, jmin, jmax, level)
For j = jmin To jmax
Cells(1, level) = j
'your code when a value of j is set
If level < NofL Then
Nestedloop NofL, jmin + 1, jmax, level + 1
Else
'your code when the number of loops is reached
End If
Next j
End Sub
Your question can be read in more than one way. If you are looking for a tool to help in generating boiler-plate code, perhaps something like this:
'In the following code, if vars is missing, successive loop indices are "i", "j", "k", etc
'otherwise, vars is treated as the loop vars and should be passed as a 0-based array with
'depth strings, where depth is how deeply nested the loops are
Function NestedFors(lim As Long, depth As Long, Optional vars As Variant) As String
Dim i As Long, n As Long
Dim codeShell As String
If IsMissing(vars) Then
vars = Split("i j k l m n o p q r s t u v w x y z") 'should be overkill -- if not, you deserve a runtime error!
End If
codeShell = "For " & vars(0) & " = 1 To " & lim & vbCrLf
For i = 1 To depth - 1
codeShell = codeShell & String(i, vbTab)
codeShell = codeShell & "For " & vars(i) & " = " & vars(i - 1) & " + 1 To " & lim & vbCrLf
Next i
codeShell = codeShell & String(depth, vbTab) & "'----- Insert code here ------" & vbCrLf
For i = depth - 1 To 1 Step -1
codeShell = codeShell & String(i, vbTab) & "Next " & vars(i) & vbCrLf
Next i
codeShell = codeShell & "Next " & vars(0) & vbCrLf
NestedFors = codeShell
End Function
Then, for example if you type
?nestedfors(50,4)
in the Immediate Window you get the following (which can be copy-pasted to a code window above:
For i = 1 To 50
For j = i + 1 To 50
For k = j + 1 To 50
For l = k + 1 To 50
'----- Insert code here ------
Next l
Next k
Next j
Next i
edited to produce nested loops
Option Explicit
Sub main()
Dim NumberOfForLoops As Long
NumberOfForLoops = 3
ForLoops NumberOfForLoops, 1, 50
End Sub
Sub ForLoops(nLoops As Long, jMin As Long, jMax As Long, Optional level As Long)
Dim j As Long
If level = 0 Then level = 1
For j = jMin To jMax
If level < nLoops Then
ForLoops nLoops, jMin + 1, jMax, level + 1
Else
'your "someother" code
End If
Next j
End Sub
If you want to run the first nested loop "NumberOfForLoops" times, just change the "To" part to NumberOfForLoops.
For i = 1 To 50
For j = 1 To NumberOfForLoops
For k = j + 1 To 50
..........................
'Here I have someother code
..........................
Next k
Next j
Next i
I have an issue with my VBA code. I try to go through a whole table that has a lot of data. I go through a first column with a first condition required. Once this condition is complete, I go through the column next to the first one but starting at the same position I stopped the previous one. Once the second condition is complete, I try to do a copy paste. But for some reasons I got the error "Subscript out of Range" Could you please help me?
Here is the code:
Sub Match()
Dim i As Integer
i = 0
Dim j As Integer
Do
i = i + 1
Loop Until Sheets("Sheet1").Range("A1").Offset(i, 0).Text = Sheets("Sheet2").Range("I5").Text
j = i
Do
j = j + 1
Loop Until Sheets("Sheet1").Range("B1").Offset(j, 0).Value = Sheets("Sheet2").Range("I11").Value
Sheets("Sheet1").Range("C1").Offset(j, 0).Copy
Sheets("Sheet2").Range("N11").Paste
End Sub
Thanks guys
This should do the same thing without any loops:
Sub Match()
Dim lastA As Long, lastB As Long
Dim i As Long, j As Long
With Sheets("Sheet1")
last a = .Cells(.Rows.count, 1).End(xlUp).Row
last b = .Cells(.Rows.count, 2).End(xlUp).Row
End With
i = WorksheetFunction.Match(Sheets("Sheet2").Range("I5").Text, Sheets("Sheet1").Range("A:A"), 0)
j = WorksheetFunction.Match(Sheets("Sheet2").Range("I11").value, Sheets("Sheet1").Range("B" & i & ":B" & lastB), 0)
Sheets("Sheet2").Range("N11").value = Sheets("Sheet1").Cells(j, 3).value
End Sub
I didn't get the same error as you but I changed the last line and it seems to work.
Sub Match()
Dim i As Integer
i = 0
Dim j As Integer
Do
i = i + 1
Loop Until Sheets("Sheet1").Range("A1").Offset(i, 0).Text = Sheets("Sheet2").Range("I5").Text
j = i
Do
j = j + 1
Loop Until Sheets("Sheet1").Range("B1").Offset(j, 0).Value = Sheets("Sheet2").Range("I11").Value
Sheets("Sheet1").Range("C1").Offset(j, 0).Copy Destination:=Sheets("Sheet2").Range("N11")
End Sub
I did notice that your code runs for ever if you do not get a match which is not good. You may want to add a solution to this. It can be as easy as adding
Or i > 10000 on the Loop Until lines.
I modified your code slightly:
Sub Match()
Dim i As Integer
i = 0
Dim j As Integer
Do
i = i + 1
Loop Until Sheets("Sheet1").Range("A1").Offset(i, 0).Text = Sheets("Sheet2").Range("I5").Text
j = i
Do
j = j + 1
Loop Until Sheets("Sheet1").Range("B1").Offset(j, 0).Value = Sheets("Sheet2").Range("I11").Value
Sheets("Sheet1").Range("C1").Offset(j, 0).Copy Sheets("Sheet2").Range("N11")
End Sub
and it worked fine with data like:
In Sheet1.
Note the B match must be below the A match.
here's what my macro does. It finds a string given a large excel file and goes to that column. At that point, it finds a user inputted string and copies all results onto the column next to it. I started learning VBA yesterday, so any help is appreciated.
here's where it gets the error
While InStr(UCase(Worksheets("Sheet1").Cells(1, j)), UCase("request")) = 0
Here's my complete macro so far.
Sub FineMe()
Dim i, j As Long
Dim count, test As Integer
userinput = InputBox("Enter String", Search, "Collect user input")
Cells.Interior.ColorIndex = 28
While InStr(UCase(Worksheets("Sheet1").Cells(1, j)), UCase("request")) = 0
j = j + 1
Wend
EndRow = Worksheets("Sheet1").Cells(Rows.count, j).End(xlUp).Row
count = 1
For i = 1 To EndRow
test = InStr(UCase(Cells(i, j)), UCase(userinput))
If test > 0 Then
Cells(count, j + 1).Value = Cells(i, j).Value
count = count + 1
End If
Next i
End Sub
Any help would be appreciated. THANKS!
Just add j = 1 before While, because after declaration Dim i, j As Long we have j equals to 0 and Worksheets("Sheet1").Cells(1, 0) triggers an error (we haven't Cells(1,0))
Sub FineMe()
Dim i, j As Long
Dim count, test As Integer
userinput = InputBox("Enter String", Search, "Collect user input")
Cells.Interior.ColorIndex = 28
j = 1
While InStr(UCase(Worksheets("Sheet1").Cells(1, j)), UCase("request")) = 0
j = j + 1
Wend
EndRow = Worksheets("Sheet1").Cells(Rows.count, j).End(xlUp).Row
count = 1
For i = 1 To EndRow
test = InStr(UCase(Cells(i, j)), UCase(userinput))
If test > 0 Then
Cells(count, j + 1).Value = Cells(i, j).Value
count = count + 1
End If
Next i
End Sub
BTW, in line Dim i, j As Long only j is Long, but i is Variant. You should use Dim i As Long, j As Long instead. The same thing with Dim count, test As Integer - you should declare it as follows: Dim count As Integer, test As Integer
i think Instr(1, what you wrote.
clic Instr in VB editor, and press F1
I'm currently writing a sub but I'm unclear of how to approach the problem programatically
Essentially I have a sheet with a column of data values starting at "A1"
How do I write a sub that will check through the column to find the largest pattern starting from the first cell and the direction of the pattern?
ie. if A1 is 2, A2 is 5, A3 is -2 ... the sub should return 2 (positive 2 days in a row)
if A1 is -2, A2 -1, A3 is -5, A4 is -2, A5 -1, A6 2 ... the sub should return -5 (negative 5 days in a row)
What I want is to somehow gather this number but in the process also save the last row in the pattern so I can compute averages, std variation etc. to store to a collection
Here is the code to check for patterns.... the j is a column counter... I need to figure out how to make the loop go back up to right before the for loop instead of iterating the j variable and then going back down....
but in any case here is the check pattern sub
<i> Sub pattern_recogADR()
'add back in as parameters
x As Long
pat_days As Long
sht_start As Long
x = 1
pat_days = 5
sht_start = 13
Dim st As Long
Dim st_num As Long
Dim st_end As Long
Dim count As Long
Dim patrn As Long
count = sht_start
Dim i As Long
Set pat = New pattern
For j = 8 To 12
st_num = 0
If IsNumeric(Cells(count, j).value) Then
st_num = count 'sets default pattern to beginning cell value
If Cells(st_num, j).value < 0 Then
For i = count + 1 To count + 1 + pat_days
If IsNumeric(Cells(i, j).value) And Cells(i, j).value < 0 Then
st_end = i
Else
Exit For
End If
Next i
patrn = st_end - st_num
tix.arbPnl = patrn
'**CONFUSION HERE WANT TO SAVE PATTERN TO AN EXISTING COLLECTION STARTING `
'AT THE FIRST ITEM **
ElseIf Cells(st_num, j).value > 0 Then
For i = count + 1 To count + 1 + pat_days
If IsNumeric(Cells(i, j).value) And Cells(i, j).value < 0 Then
st_end = i
Else
Exit For
End If
Next i
patrn = st_end - st_num
TIX.arbPnl = patrn
'save to separate class for patterns
Else
count = count + 1
End If
Next j
End Sub
Here is where I previously define the object. Basically I want to get this pattern and then add it to the respective attribute (? I dont know coding vocab) in this collection which is already define so the pattern matches with the respective item in the collection.
Option Explicit
Public TixCollection As New Collection
Sub DefineTixCollection()
Application.ScreenUpdating = False
Sheets("Input").Activate
Set TixCollection = Nothing
Dim tix As clsTix
Dim i As Long
Dim last_row As Long
last_row = Range("A" & Rows.count).End(xlUp).Row
'Add tix properties
For i = 3 To last_row
Set tix = New clsTix
'only adds active tickers to collection
If Range("A" & i).value = "x" Then
'Random data
tix.ORD = Range("B" & i).value
tix.ADR = Range("C" & i).value
tix.ratio = Range("D" & i).value
tix.crrncy = Range("E" & i).value
tix.hedge_index = Range("F" & i).value
tix.hedge_ord = Range("G" & i).value
tix.hedge_ratio = Range("H" & i).value
' ADR is the id key
TixCollection.Add tix, tix.ADR
End If
Next i
' Error Check
' For i = 1 To 5
' 'retrieve by collection index
' Debug.Print TixCollection(i).ORD
' Debug.Print TixCollection(5).ADR
' Debug.Print TixCollection(5).ratio
' Debug.Print TixCollection(i).crrncy
' Debug.Print TixCollection(i).hedge_index
' Debug.Print TixCollection(i).hedge_ord
' Debug.Print TixCollection(i).hedge_ratio
' Next i
End Sub
Any help would be much appreciated getting frustrated now... ugh
Sub Button1_Click()
Dim patrn() As Long
ReDim patrn(0 To 4)
Dim count As Long
Dim posCount As Integer
Dim negCount As Integer
Dim sign As Boolean
posCount = 0
negCount = 0
count = 0
Dim i As Long
Dim j As Integer
Dim lastRow As Long
For j = 8 To 12
lastRow = ActiveSheet.Cells(ActiveSheet.Rows.count, j).End(xlUp).Row
For i = 1 To lastRow
If IsNumeric(Cells(i, j).Value) Then
If count = 0 Then
If Cells(i, j).Value > 0 Then
sign = True
posCount = posCount + 1
ElseIf Cells(i, j).Value < 0 Then
sign = False
negCount = negCount + 1
End If
ElseIf count > 0 And count <= 4 Then
If Cells(i, j).Value > 0 And sign = True Then
sign = True
posCount = posCount + 1
ElseIf Cells(i, j).Value > 0 And sign = False Then
sign = True
posCount = 1
ElseIf Cells(i, j).Value < 0 And sign = True Then
sign = False
negCount = 1
ElseIf Cells(i, j).Value < 0 And sign = False Then
sign = False
negCount = negCount + 1
End If
ElseIf count = 5 Then
Exit For
End If
count = count + 1
End If
Next i
If posCount > negCount Then
patrn(j - 8) = posCount
Else
patrn(j - 8) = negCount - (negCount * 2)
End If
negCount = 0
posCount = 0
count = 0
Next j
'Do your other calculations here.
For i = LBound(patrn) To UBound(patrn)
Debug.Print patrn(i)
Next
End Sub