I'm having trouble with this sequence of if statements. The error I'm getting is: Object required. I'm just going to give the relevant area of the code, please assume all variables are properly defined.
For i = 6 To LastRow
If Cell.Value("$I" & i) = "" Then
Cell.Value("$I" & i) = Format(Now(), "MMM-DD-YYYY")
ElseIf Cell.Value("$N" & i) = "" Then
Cell.Value("$I" & i) = Application.WorksheetFunction.WorkDay("$J" & i + "$L" & i - 1, 1)
End If
Next i
I'm having trouble getting the workday function to work properly. Any ideas?
Let's try to add some fixes:
For i = 6 To LastRow
If Cells( i, "I").Value = "" Then
Cells( i, "I").Value = Format(Now(), "MMM-DD-YYYY")
ElseIf Cells( i, "N").Value = "" Then
Cells( i, "I").Value = Format(Application.WorksheetFunction.WorkDay(Cells(i, "J").Value, 1), "MMM-DD-YYYY")
End If
Next i
Related
I have code which is used for concatenation. The cells are dynamic; whenever a change in cells in a range the concatenation function will automatically execute and gives the value. Currently I asked the concatenation function which has to run for the complete range even though the modification is in a single row. Which is causing a lot of time during the execution.
Is there is any way to define to update only a single row that is modified? I know the technique if the range is single column, for multiple columns I didn't have any idea.
My Code
ColumnLetter3 = Split(Cells(1, c1_column).Address, "$")(1)
ColumnLetter4 = Split(Cells(1, c6_column).Address, "$")(1)
Range3 = ColumnLetter3 & st_workrow2 + 1 & ":" & ColumnLetter4 & last_cell1
Set xrng3 = Range(Range3)
If Not Application.Intersect(xrng3, Range(Target.Address)) _
Is Nothing Then
For i = c_row + 1 To last_cell1
If Cells(i, c1_column) = "" And Cells(i, c2_column) = "" And Cells(i, c3_column) = "" And Cells(i, c4_column) = "" And Cells(i, c5_column) = "" And Cells(i, c6_column) = "" Then
Cells(i, c_column) = ""
Else
Cells(i, c_column) = Cells(i, c1_column) & "-" & Cells(i, c2_column) & "-" & Cells(i, c3_column) & "-" & Cells(i, c4_column) & "-" & Cells(i, c5_column) & "-" & Cells(i, c6_column)
Cells(i, c_column).Replace what:="+", Replacement:=""
Cells(i, c_column).Replace what:="-----", Replacement:="-"
Cells(i, c_column).Replace what:="----", Replacement:="-"
Cells(i, c_column).Replace what:="---", Replacement:="-"
Cells(i, c_column).Replace what:="--", Replacement:="-"
If Right(Cells(i, c_column), 1) = "-" Then
l = Len(Cells(i, c_column))
Cells(i, c_column) = Left(Cells(i, c_column), l - 1)
End If
If Left(Cells(i, c_column), 1) = "-" Then
l = Len(Cells(i, c_column))
Cells(i, c_column) = Right(Cells(i, c_column), l - 1)
End If
End If
Next I
Endif
It's hard to tell exactly what you're doing here (perhaps strip down your question?), however looks like you want to get a list of the rows in your target? In that case you can isolate it using Columns(1). See below...
If Not Application.Intersect(xrng3, Range(Target.Address)) _
Is Nothing Then
Dim aCell As Range
For Each aCell In Target.Columns(1).Cells
i = aCell.Row
If Cells(i, c1_column) = "" And Cells(i, c2_column) = "" And Cells(i, c3_column) = "" And Cells(i, c4_column) = "" And Cells(i, c5_column) = "" And Cells(i, c6_column) = "" Then
'skipped....
End If
Next aCell
End If
I have some problems with excel and VBA, in that don't know have much knowledge. I copied text from pdf and it's awful.
I have cells which contain some text.
The problem is that the text from one paragraph is broken down over several cells. At the beginning of each paragraph is a word in bold (e.g. CLR.) which describes the rest of the text. As such, it defines where each paragraph should start. How I can merge these cells into one?
I see
I want
Sub MergeText()
Dim strMerged$, r&, j&, i&
r = 1
Do While True
If Cells(r, 1).Characters(1, 1).Font.Bold Then
strMerged = "": strMerged = Cells(r, 1)
r = r + 1
While (Not Cells(r, 1).Characters(1).Font.Bold) And Len(Cells(r, 1)) > 0
strMerged = strMerged & Cells(r, 1)
r = r + 1
Wend
i = i + 1: Cells(i, 2) = strMerged
Cells(i, 2).Characters(1, InStr(1, strMerged, ".", vbTextCompare)).Font.Bold = True
Else
Exit Do
End If
Loop
End Sub
Modify (if needed) and try:
Option Explicit
Sub test()
Dim LastRow As Long, i As Long, j As Long, Count As Long
Dim str As String
With ThisWorkbook.Worksheets("Sheet1") 'Change sheet name if needed
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
If (UCase(Left(.Range("A" & i), 1)) <> Left(.Range("A" & i), 1)) And UCase(Left(.Range("A" & i - 1), 1)) = Left(.Range("A" & i - 1), 1) Then
Count = 0
For j = 1 To Len(.Range("A" & i - 1))
If .Range("A1").Characters(j, 1).Font.FontStyle = "Bold" Then
Count = Count + 1
Else
Exit For
End If
Next j
str = .Range("A" & i - 1).Value & " " & .Range("A" & i).Value
With .Range("A" & i - 1)
.Value = str
.Font.Bold = False
With .Characters(Start:=1, Length:=Count).Font
.FontStyle = "Bold"
End With
End With
.Rows(i).EntireRow.Delete
ElseIf (UCase(Left(.Range("A" & i), 1)) <> Left(.Range("A" & i), 1)) And UCase(Left(.Range("A" & i - 1), 1)) <> Left(.Range("A" & i - 1), 1) Then
str = .Range("A" & i - 1).Value & " " & .Range("A" & i).Value
With .Range("A" & i - 1)
.Value = str
.Font.Bold = False
End With
.Rows(i).EntireRow.Delete
End If
Next i
End With
End Sub
I am surprised there's no answer for this. I have read Setting Dynamic Ranges in VBA and Selecting Dynamic Range and Autofill Dynamic Range Last Row and Last Column and MSDN
I have multiple, distinct ranges on a sheet with varying sizes. I am trying to subtotal column L. I can do it using a hardcoded sum (via subtotal variable) but I want to insert a formula into the cell instead. This requires knowing the starting and end rows for each range. My code almost works. It fails when the range only consists of one row. Even so, I feel there's gotta be a smarter way to do this.
How does one determine the start and end row of a range on a sheet filled with multiple ranges?
For i = 2 To j
If .Cells(i + 1, "L") = "" And .Cells(i + 2, "L") = "" Then
b = .Cells(i - 1, "J").End(xlUp).Row
End If
subtotal = subtotal + .Cells(i, "L").Value2
If .Cells(i, 1) = "" And .Cells(i - 1, "B") <> "" Then
If .Cells(i - 1, "K") = 0 Then
.Cells(i, "K").Value2 = "Check Payment"
'Set sumRng = .Range(.Cells(b, "L"), .Cells(i - 1, "L"))
.Cells(i, "L").Formula = "=sum(L" & b & ":L" & i - 1 & ")"
.Cells(i - 1, "L").Borders(xlEdgeBottom).LineStyle = xlContinuous
total = total + subtotal
subtotal = 0
ElseIf .Cells(i - 1, "K") = "Checking" Then
.Cells(i, "K").Value2 = "EFT Payment"
'Set sumRng = .Range(.Cells(b, "L"), .Cells(i - 1, "L"))
.Cells(i, "L").Formula = "=sum(L" & b & ":L" & i - 1 & ")"
.Cells(i - 1, "L").Borders(xlEdgeBottom).LineStyle = xlContinuous
total = total + subtotal
subtotal = 0
End If
End If
Next
You can loop through the column like this:
For i = 2 To mySheet.Range("B" & Rows.Count).End(xlUp).Row + 1
If Range("B" & i).Value <> vbNullString Then
If Range("B" & i - 1).Value = vbNullString Then
j = i
End If
Else
If Range("B" & i - 1).Value <> vbNullString And Range("B" & i - 1).Formula <> "=SUM(B" & j & ":B" & i - 2 & ")" Then
Range("B" & i).Formula = "=SUM(B" & j & ":B" & i - 1 & ")"
End If
End If
Next i
This uses Match to skip chunks and as such the number or loops are less
With ActiveSheet
Dim b As Long
b = 2
Do Until b = .Rows.Count
Dim x As Variant
x = .Evaluate("Match(True, Index(" & .Range(.Cells(b, "l"), .Cells(.Rows.Count, "l")).Address & " <> """",),0)")
If Not IsError(x) Then
b = b + x - 1
Else
Exit Sub
End If
x = .Evaluate("Match(True, Index(" & .Range(.Cells(b, "l"), .Cells(.Rows.Count, "l")).Address & " = """",),0)")
Dim i As Long
i = b + x - 1
.Cells(i, "l").Formula = "=sum(L" & b & ":L" & i - 1 & ")"
b = i + 2
Loop
End With
Hi I would like to apply the below vba to the entire column AK instead of just AK1
Sub Tidy_Cell()
Range("AK1") = Replace(Range("AK1"), Chr(13), "")
For x = 1 To Len(Range("AK1"))
If Mid(Range("AK1"), x, 1) = Chr(10) And Mid(Range("AK1"), x + 1, 1) = Chr(10) Then
Range("AK1") = Left(Range("AK1"), x) & Mid(Range("AK1"), x + 2)
End If
Next
With Range("A1")
.Value = Mid(.Value, 1)
.VerticalAlignment = xlTop
End With
End Sub
Thanks a lot for any help!
I would put all your code into a Loop that checks column AK
dim lLastUsed As Long
lLastUsed = Cells(1048576, "AK").End(xlUp).Row
For i = 1 to lLastused
//insert your code here
Next i
Remember every spot you defined it to be Range("AK1") you need to change it to Range("AK" & i) so it ends up something like this:
Sub Tidy_Cell()
Dim lLastUsed As Long
lLastUsed = Cells(1048576, "AK").End(xlUp).Row
For i = 1 to lLastUsed
Range("AK" & i) = Replace(Range("AK" & i), Chr(13), "")
For x = 1 To Len(Range("AK" & i))
If Mid(Range("AK" & i), x, 1) = Chr(10) And Mid(Range("AK" & i), x + 1, 1) = Chr(10) Then
Range("AK" & i) = Left(Range("AK" & i), x) & Mid(Range("AK" & i), x + 2)
End If
Next x
Next i
With Range("A1")
.Value = Mid(.Value, 1)
.VerticalAlignment = xlTop
End With
End Sub
Hope this helps you out
I am trying to automate my SKU numbers. I have 3 columns. The first column has 28, the second has 6 and finally the third has 58.
I want the SKU to have a Trend like so 0{(###)col1}{(##)col2}{(##)col3}0
My Code looks like this
Sub SKU()
Dim x As Long
x = 1
i = 1
j = 1
k = 1
Do While Cells(i, 1) <> ""
Do While Cells(j, 2) <> ""
Do While Cells(k, 3) <> ""
Cells(x, 4).Value = Format(0, "0") & Format(i, "000") & _
Format(j, "00") & Format(k, "00") & Format(0, "0")
k = k + 1
x = x + 1
Loop
j = j + 1
Loop
i = i + 1
Loop
End Sub
No need to use the Do Loop. Find the last row and then use a For loop.
Is this what you are trying?
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long, i As Long
'~~> Change this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet2")
With ws
'~~> Find last row
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 1 To lRow
If .Cells(i, 1) <> "" And .Cells(i, 2) <> "" And .Cells(i, 3) <> "" Then
'0{(###)col1}{(##)col2}{(##)col3}0
.Cells(i, 4).Value = "'0" & _
Format(.Cells(i, 1), "000") & _
Format(.Cells(i, 2), "00") & _
Format(.Cells(i, 3), "00") & _
"0"
End If
Next i
End With
End Sub
Output for 28,6,58 is 002806580
As i mentioned in the comment to the question, remove first and second do-while loop then replace:
Cells(x, 4).Value = Format(0, "0") & Format(i, "000") & _
Format(j, "00") & Format(k, "00") & Format(0, "0")
with:
Cells(k, 4) = "'" & Format(Cells(k, 1), "000") & _
Format(Cells(k, 2), "00") & Format(Cells(k, 3), "00")
Result: 0280658
In case you want to add leading and ending zeros:
Cells(k, 4) = "'0" & Format(Cells(k, 1), "000") & _
Format(Cells(k, 2), "00") & Format(Cells(k, 3), "00") & "0"
Result: 002806580