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
Related
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'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
I'm trying to get an output in column U for multiple worksheets in a workbook. The return string will either be "Yes" or "No" depending on which column is not blank and if the difference between two dates are > 150. This is the code I have written, but nothing shows up in column U. Could anyone help me figure out why this isn't working?
Sub Compliance()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Dim i As Integer
Dim listLength
listLength = ws.Cells(Rows.Count, "M").End(xlUp).Row - 1
For i = 2 To listLength + 2
If IsEmpty(ws.Range("P" & i)) = True And IsEmpty(ws.Range("O" & i)) = True And IsEmpty(ws.Range("N" & i)) = True And DateDiff("d", ws.Range("M" & i), ws.Range("K" & i)) > 150 Then
ws.Range("U" & i) = "Yes"
ElseIf IsEmpty(ws.Range("P" & i)) = True And IsEmpty(ws.Range("O" & i)) = True And DateDiff("d", ws.Range("N" & i), ws.Range("M" & i)) < 150 Then
ws.Range("U" & i) = "Yes"
ElseIf IsEmpty(ws.Range("P" & i)) = True And DateDiff("d", ws.Range("O" & i), ws.Range("N" & i)) < 150 Then
ws.Range("U" & i) = "Yes"
ElseIf DateDiff("d", ws.Range("N" & i), ws.Range("M" & i)) < 150 Then
ws.Range("U" & i) = "Yes"
Else
ws.Range("U" & i) = "No"
End If
Next
Next ws
End Sub
When you start your loop with For Each ws In ThisWorkbook.Worksheets then Excel starts processing from Sheet1 and I'm sure your list in another sheet.
So, the reason nothing changes in your U column is, because you are
looking at wrong Worksheet.
As long as you would like to loop through all of your worksheets, start to follow your lists from Sheet1. If you would like to loop in different order, you should define this in your code.
And below I edited some part of your code and also added msgbox ws.name to show you in which sheet Excel is working now.
Why Use Integer Instead of Long?
Option Explicit
Sub Compliance()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Dim i As Long
Dim listLength
MsgBox ws.Name
listLength = ws.Cells(ws.Rows.Count, "M").End(xlUp).Row - 1
For i = 2 To listLength + 2
If IsEmpty(ws.Range("P" & i)) = True And IsEmpty(ws.Range("O" & i)) = True And IsEmpty(ws.Range("N" & i)) = True And DateDiff("d", ws.Range("M" & i), ws.Range("K" & i)) > 150 Then
ws.Range("U" & i) = "Yes"
ElseIf IsEmpty(ws.Range("P" & i)) = True And IsEmpty(ws.Range("O" & i)) = True And DateDiff("d", ws.Range("N" & i), ws.Range("M" & i)) < 150 Then
ws.Range("U" & i) = "Yes"
ElseIf IsEmpty(ws.Range("P" & i)) = True And DateDiff("d", ws.Range("O" & i), ws.Range("N" & i)) < 150 Then
ws.Range("U" & i) = "Yes"
ElseIf DateDiff("d", ws.Range("N" & i), ws.Range("M" & i)) < 150 Then
ws.Range("U" & i) = "Yes"
Else
ws.Range("U" & i) = "No"
End If
Next
Next ws
End Sub
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
I have the following code so far to subtract one column from another, but then need to take that result and if D is negative then F = D + F else E = E + D
Sub PopCol()
Range("D3:D19").Formula = "=RC[-1]-RC[-2]" 'D=C-B
I'm Lost! Been trying different formats for range in this and have had no luck-HELP!
Thank You!
Is this what you are trying?
Sub PopCol()
Dim rng As Range, aCell As Range
Set rng = Range("D3:D19")
rng.Formula = "=RC[-1]-RC[-2]"
For Each aCell In rng
Select Case aCell.Value
Case Is < 0 '<~~ If value in D is negative
'~~> F = F + D
aCell.Offset(, 2).Value = aCell.Offset(, 2).Value + aCell.Value
Case Else
'~~> E = E + D
aCell.Offset(, 1).Value = aCell.Offset(, 1).Value + aCell.Value
End Select
Next
End Sub
Try below code :
Sub PopCol()
For i = 3 To 19
Range("D" & i) = CLng(Range("C" & i) - Range("B" & i))
If (Range("D" & i) < 0) Then
Range("F" & i) = Range("D" & i) + Range("F" & i)
Else
Range("E" & i) = Range("E" & i) + Range("D" & i)
End If
Next
End Sub