I'm creating a Macro to do almost exactly what is outlined here:
Excel/Categorization Macro(formula) based on string of text containing keywords
My question is that in the code from the example above Like "" is used to check to see if the Description matches a keyword and if it does then it pulls the corresponding category name. In my case, I don't currently have keywords for every possible category (but will eventually have them as I collect more transaction data), meaning some of the cells in my keyword column are blank and the way the above code is written it considers patternfound = true when it encounters an empty cell. How do I alter the If statement with "Like" or something similar so that it skips over a cell if it's completely blank and only provides a match when there are some characters (that match) in the cell?
I've found a work around by putting "N/A" in the empty cells but I'd rather not do that. Here is my code:
Sub Categorize()
Dim lastrow As Long, lastrow2 As Long
Dim i As Integer, j As Integer
Dim PatternFound As Boolean
Call speedup
lastrow = Sheets("Categorization").Range("B" & Rows.Count).End(xlUp).Row
lastrow2 = Sheets("Cleaned Spend Data").Range("C" & Rows.Count).End(xlUp).Row
For i = 4 To lastrow2
PatternFound = False
j = 1
Do While PatternFound = False And j < lastrow
j = j + 1
If UCase(Sheets("Cleaned Spend Data").Range("B" & i).Value) Like "*" & UCase(Sheets("Categorization").Range("B" & j).Value) & "*" Then
Sheets("Cleaned Spend Data").Range("D" & i).Value = Sheets("Categorization").Range("A" & j).Value
PatternFound = True
End If
Loop
Next i
Call normal
End Sub
Thanks!
You can test for an empty cell...
Also - your code could be cleaner using a couple of variables for your worksheets.
Sub Categorize()
Dim lastrow As Long, lastrow2 As Long
Dim i As Integer, j As Integer
Dim PatternFound As Boolean, shtCat As Worksheet, shtCleaned As Worksheet
Dim v, t
Set shtCat = Sheets("Categorization")
Set shtCleaned = Sheets("Cleaned Spend Data")
Call speedup
lastrow = shtCat.Range("B" & Rows.Count).End(xlUp).Row
lastrow2 = shtCleaned.Range("C" & Rows.Count).End(xlUp).Row
For i = 4 To lastrow2
v = UCase(UCase(shtCleaned.Range("B" & i).Value))
For j = 1 To lastrow
t = UCase(Sheets("Categorization").Range("B" & j).Value)
If Len(t) > 0 And v Like "*" & t & "*" Then
shtCleaned.Range("D" & i).Value = shtCat.Range("A" & j).Value
Exit For
End If
Next j
Next i
Call normal
End Sub
Related
I'm making a VBA macro to concatenate a number given by the user with a previous column value. Once the loop gets to the value given by the user (the top value), the loop would start again since number one. By now my loop gets to the top value and starts from one, but every time this happened the code skip to the next cell, could you tell me why is this happening guys? (down value by default).
Sorry i'm a little bit new on VBA, here is my try:
Sub Balance()
Dim myValue As Integer
myValue = InputBox("Please, give me a number")
Range("A2").Select
Range("A:A,C:C,F:F,H:J,L:L,T:T,W:X").Delete
Range("A2").Select
firstrow = ActiveCell.Row
Selection.End(xlDown).Select
lastrow = ActiveCell.Row
For i = 1 To lastrow
If Range("M" & i) = "AB" Then
For j = 1 To myValue
watcher = j
Range("N" & i) = "TV" & " " & Range("M" & i) & " " & watcher
i = i + 1
Next j
End If
Next i
End Sub
This the output with the number 10 as input (Column N):
I would like to reach this goal:
You already have your answer by Vandear explaining why the row is getting skipped. However here is an alternative way using only one loop to achieve what you want. But before that couple of suggestions
Suggestions:
Use Option Explicit and declare your variables. You may want to see Optimizing the VBA Code and improve the performance
Avoid the use of Select/Activate You may want to see How to avoid using Select in Excel VBA
Avoid the use of xlDown to get the last row. You may want to see Finding Last Row
When accepting number from users, use Application.InputBox with a Type:=1 instead of just InputBox. This way you will only restrict numbers.
Is this what you are trying?
Code:
Option Explicit
Sub Balance()
Dim ws As Worksheet
Dim lRow As Long
Dim i As Long, counter As Long
Dim myValue As Long
myValue = Application.InputBox(Prompt:="Please, give me a number", Type:=1)
If myValue < 1 Then Exit Sub
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
'~~> For demonstration below. I did not use this line below. But
'~~> If you need to delete those columns then use it this way
.Range("A:A,C:C,F:F,H:J,L:L,T:T,W:X").Delete
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Set your counter
counter = 1
For i = 1 To lRow
If .Range("M" & i) = "AB" Then
Range("N" & i) = "TV" & " " & .Range("M" & i).Value2 & " " & counter
counter = counter + 1
'~~> Reset your counter if it crosses user input
If counter > myValue Then counter = 1
End If
Next i
End With
End Sub
In action:
Couple of things before I answer your problem:
It's advisable to declare your variables for better structure:
Dim i As Integer, j As Integer, MyValue As Integer, firstrow As Integer, lastrow As Integer
You can skip the selection of a cell and directly reference it:
firstrow = Range("A2").Row
lastrow = Range("A2").End(xlDown).Row
The Answer to your Problem:
When the code exits the for-next loop for j, i is increased by 1 (i=i+1), and then it will be increased again by 1 when it proceeds to the next i line. This is the reason why it skips to the next row. So after the for-next loop for j, you need to decrease i by 1 before proceeding to the for-next loop for i.
For i = 1 To lastrow
If Range("M" & i) = "AB" Then
For j = 1 To myValue
watcher = j
Range("N" & i) = "TV" & " " & Range("M" & i) & " " & watcher
i = i + 1
Next j
i=i-1 <-------
End If
Next i
I have a table where I need to find a final score based on time used (Column A and B) and points scored(row 2). e.g. If the person used 43 seconds and scored 11 points, the final score would be 10.
My first thought was too loop through the time to get the row number like this:
Do Until (.Range("A" & i).Value <= time) And _
(.Range("B" & i).Value >= time)
i = i + 1
Loop
cellN = i
And then loop through the points to get the column letter and then add them together with something like this:
finalScore = .Range(cellL & cellN).Value
But how do I loop through the columns? And is there an easier way of storing the final score in a variable?
Try the next function, please:
Function FinalScore(lTime As Long, points As Long) As Long
Dim sh As Worksheet, lastRow As Long, lastCol As Long
Dim colP As Long, i As Long
Set sh = ActiveSheet 'use here your specific worksheet
lastRow = sh.Range("A" & Rows.count).End(xlUp).Row
lastCol = sh.cells(1, Columns.count).End(xlToLeft).Column
For i = 2 To lastRow
If lTime >= sh.Range("A" & i).Value And _
lTime <= sh.Range("B" & i).Value Then
colP = WorksheetFunction.Match(points, sh.Rows(2), 0)
FinalScore = sh.cells(i, colP).Value: Exit Function
End If
Next i
End Function
It can be called/checked in this way:
Sub testFinalScore()
MsgBox FinalScore(43, 11)
End Sub
This is the basic. It must be improved with some error handling part. To warn in case of not using Long variables as parameters, if they exceed the existing range limits etc...
I am newbie in here in Stackoverflow and in the VBA Field. Actually I need some help with my code.
I have created a VBA(macro) and it seems there is missing with my code.
Scenario:
if column B3 has an answer(either: "FLAT" or "PER") should be applicable to all column which is same in Column A3
for example
if A3 until A500 then B3 until B500 has also an answer (either: "FLAT" or "PER").
Sub exe()
Dim number As Integer, result As String
number = Range(“a1”).Value
If number <= 1 Then
result = “Flat”
Else: result = “Per”
End If
Range(“b1”).Value = result
End Sub
Are you look for something like this:
Sub exe()
Dim LastRow As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If .Range("A" & i).Value = 0.5 Then
.Range("B" & i).Value = "FLAT"
ElseIf .Range("A" & i).Value = 2 Then
.Range("B" & i).Value = "PER"
End If
Next i
End With
End Sub
I am trying to identify a specific range in column-A and concatenate two cells within the specific range and delete the empty cell. I have been successful in putting a code together and it does the job very well. But, I don't know how to loop it to identify next range. Any help would be appreciated.
As per below image and code, First, I am finding and selecting a range between two (MCS) in column-A with a condition that, if the rows are more than 8 between two MCS. Then I am concatenating first 2 cells immediately after MCS and delete the empty row.
The below code works well for first range but I am unable to loop to identify next range from row 22 to 32 and perform concatenations. I want to loop in column-A as there will be more MCS.
Sub MergeStem()
Dim findMCS1 As Long
Dim findMCS2 As Long
Dim myCount As Integer
Dim myStems As Long
Dim mySelect As Range
Dim c As Range
findMCS1 = Range("A:A").Find("MCS", Range("A1")).Row
findMCS2 = Range("A:A").Find("MCS", Range("A" & findMCS1)).Row
myCount = Range("A" & findMCS1 + 1 & ":A" & findMCS2 - 1).Cells.Count
Range("B1").Value = myCount
MsgBox "Number of rows =" & myCount
Set mySelect = Selection
If myCount > 8 Then
myStems = Range("A" & findMCS1 + 2 & ":A" & findMCS2 - 9).Select
Set mySelect = Selection
For Each c In mySelect.Cells
If firstcell = "" Then firstcell = c.Address(bRow, bCol)
sArgs = sArgs + c.Text + " "
c.Value = ""
Next
Range(firstcell).Value = sArgs
End If
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub
You could try:
Option Explicit
Sub test()
Dim i As Long, Lastrow As Long, Startpoint As Long, Endpoint As Long, Diff As Long
Dim str As String
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Startpoint = 0
Endpoint = 0
For i = Lastrow To 2 Step -1
str = .Range("A" & i).Value
If str = "MCS" And Startpoint = 0 Then
Startpoint = i
ElseIf str = "MCS" And Startpoint <> 0 Then
Endpoint = i
End If
If Startpoint > 0 And Endpoint > 0 Then
Diff = Startpoint - Endpoint
If Diff > 8 Then
.Range("A" & Endpoint + 1).Value = .Range("A" & Endpoint + 1).Value & " " & .Range("A" & Endpoint + 2).Value
.Rows(Endpoint + 2).EntireRow.Delete
Startpoint = 0
Endpoint = 0
End If
End If
Next i
End With
End Sub
I have created this procedure which works fine for cleaning blank cells in column AF. I want to modify this to pass on the column number as a variable so i can use the same procedure for other columns.
Column Z is my temp working column.
any ideas?
Private Sub clean_com_cells()
Dim counter As Integer, i As Integer, lastrow As Integer
lastrow = Mysheet.Range("AF65536").End(xlUp).Row
counter = 0
For i = 1 To lastrow
If Mysheet.Cells(i, 32).Value <> "" Then
Mysheet.Cells(counter + 1, 26).Value = Mysheet.Cells(i, 32).Value
counter = counter + 1
End If
Next i
Mysheet.Range("AF1:AF" & lastrow).Value = ""
Mysheet.Range("AF1:AF" & lastrow).Value = Mysheet.Range("Z1:Z" & lastrow).Value
Mysheet.Range("Z1:Z" & lastrow).Value = ""
End Sub
This is not how I would have done what you're trying to do, but this allows you to parameterize the column number that you're trying to "clear". I think that it would help to explain what you're trying to accomplish more explicitly, but this code should get you what you need. Note, you need lastrow to be a Long since Integers only go from -32k to 32k (approx). FYI, Longs perform better than Integers in recent versions of VBA, since Integers get converted to Longs. Never use Integers. Bytes, on the other hand, do perform better if your data fits that profile (0 to 255).
Private Sub clean_com_cells(column_number as integer)
Dim counter As Integer, i As Integer, lastrow As long
Dim clear_rng as range
lastrow = Mysheet.cells(65536,column_number).End(xlUp).Row
counter = 0
For i = 1 To lastrow
If Mysheet.Cells(i, column_number).Value <> "" Then
Mysheet.Cells(counter + 1, 26).Value = Mysheet.Cells(i, column_number).Value
counter = counter + 1
End If
Next i
with mysheet
set clear_rng = Range(.cells(1,column_number), .cells(lastrow,column_number))
clear_rng.Value = .Range("Z1:Z" & lastrow).Value
Mysheet.Range("Z1:Z" & lastrow).Value = ""
end with
End Sub
You can adjust the function to take an input parameter, which I've named TargetColNumber below. I also added handy function for finding the last row in a worksheet... a future refactor might involve passing a Worksheet to the cleaning routine.
Anyway, call the function with a number and you should be good to...
Option Explicit
'this is the routine that cleans your cells
Sub clean_com_cells_in_col(TargetColNumber As Long)
Dim counter As Long, i As Long, lastrow As Long
Dim MySheet As Worksheet
Set MySheet = ThisWorkbook.ActiveSheet
lastrow = FindLastRow(MySheet)
counter = 0
For i = 1 To lastrow
If MySheet.Cells(i, TargetColNumber).Value <> "" Then
MySheet.Cells(counter + 1, 26).Value = MySheet.Cells(i, TargetColNumber).Value
counter = counter + 1
End If
Next i
With MySheet
.Range(.Cells(1, TargetColNumber), .Cells(lastrow, TargetColNumber)).Value = ""
.Range(.Cells(1, TargetColNumber), .Cells(lastrow, TargetColNumber)).Value = _
.Range(.Cells(1, 26), .Cells(lastrow, 26)).Value
.Range(.Cells(1, 26), .Cells(lastrow, 26)).Value = ""
End With
End Sub
'we'll use this function to identify the last row in a worksheet
Public Function FindLastRow(flrSheet As Worksheet) As Long
If Application.WorksheetFunction.CountA(flrSheet.Cells) <> 0 Then
FindLastRow = flrSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Else
FindLastRow = 1
End If
End Function
'this is our test
Sub TestItYall()
Call clean_com_cells_in_col(4) '<~ did it work?
End Sub
You can use a string variable for you column like you have done with lastrow. Example here uses a variable called "col":
Private Sub clean_com_cells()
Dim counter As Integer, i As Integer, lastrow As Integer,col as string
col = "AF" 'Change this to vary the column
lastrow = Mysheet.Range(col & "65536").End(xlUp).Row
counter = 0
For i = 1 To lastrow
If Mysheet.Cells(i, 32).Value <> "" Then
Mysheet.Cells(counter + 1, 26).Value = Mysheet.Cells(i, 32).Value
counter = counter + 1
End If
Next i
Mysheet.Range(col & "1:" & col & lastrow).Value = ""
Mysheet.Range(col & "1:" & col & lastrow).Value = Mysheet.Range("Z1:Z" & lastrow).Value
Mysheet.Range("Z1:Z" & lastrow).Value = ""
End Sub