Simple VBA Excel Coding

1.      If data in a cell in Column P contains more than 2 characters, then,
                      a.      data in the same row in Column N should be appended with a space and then the contents of the same row in Column O; and
                       b.      data in row in Column O is replaced with data in Column P

Example
      N            O            P
Smith                  Jr.            John

would become
      N            O            P
Smith Jr.                                John            John


2.      I have an indeterminate number of rows. I want the following code to stop running when it gets to a blank row. Right now, it stops at row 500:
Sub Proper_Case()
  Sheets("Data").Select
  Application.ScreenUpdating = False
' Loop to cycle through each cell in the specified range.
   For Each x In Range("K1:Z500")
      ' There is not a Proper function in Visual Basic for Applications.
      ' So, you must use the worksheet function in the following form:
      x.Value = Application.Proper(x.Value)
   Next
    Cells.Replace What:="Cv-", Replacement:="CV-", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="Lvnv", Replacement:="LVNV", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="Rgm", Replacement:="RGM", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="Llc", Replacement:="LLC", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="Ii", Replacement:="II", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    Application.ScreenUpdating = True
End Sub

3.       I have an indeterminate number of rows. I want to copy the formulas in the first row of columns A-E to each subsequent row that has data in column F.

4.      I want to delete all rows that have the word “Delete” in column B.
carlosabAsked:
Who is Participating?
 
Arno KosterCommented:
as above, use usedrange :

For Each Row In UsedRange.Rows
  '-- the F cell is the 6th cell in a row
  If Row.Cells(6) <> "" Then
    Row.Cells(1).Formula = Range("A1").Formula
    Row.Cells(2).Formula = Range("B1").Formula
    Row.Cells(3).Formula = Range("C1").Formula
    Row.Cells(4).Formula = Range("D1").Formula
    Row.Cells(5).Formula = Range("E1").Formula
  End If

Next Row

Open in new window

0
 
StephenJRCommented:
Can you post a workbook?
0
 
Arno KosterCommented:
question 1 :
paste as worksheet code in the VBA editor
Sub process_names()

For Row = 1 To UsedRange.Rows.Count
    If Len(Range("N" & Row)) > 2 Then
        Range("N" & Row) = Range("N" & Row) & " " & Range("O" & Row)
        Range("O" & Row) = Range("P" & Row)
    End If
Next Row


End Sub

Open in new window

0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 
Arno KosterCommented:
for the second question :

you can use "usedrange", which determines a bounding box of all cells used in a worksheet

or you can use the following code :
For Each x In Range("K1:Z500")
      ' There is not a Proper function in Visual Basic for Applications.
      ' So, you must use the worksheet function in the following form:
      if x.value = "" then exit for
      x.Value = Application.Proper(x.Value)
   Next

Open in new window

0
 
Arno KosterCommented:
and
For Each Row In UsedRange.Rows
  '-- the B cell is the 2nd cell in a row
  If Row.Cells(2) = "Delete" Then
    Row.delete
  End If

Next Row

Open in new window


please note that when deleting a row, all underlying rows move upwards. This can cripple functions relating to cells in this row.
If this is the case, you can try to

row.clear

instead of row.delete.

also : the "Delete" clause is case-sensitive. If you'd rather have a case-insensitive version, use :

if lcase(row.cells(2)) = "delete" then
0
 
carlosabAuthor Commented:
I'm getting a Run-time error '424': Object Required when I try to use the UsedRange function. E.g., for your code for question 1, I pasted this code into the sheet, and try running the macro by itself:

Sub process_names()

For Row = 1 To UsedRange.Rows.Count
    If Len(Range("N" & Row)) > 2 Then
        Range("N" & Row) = Range("N" & Row) & " " & Range("O" & Row)
        Range("O" & Row) = Range("P" & Row)
    End If
Next Row


End Sub
0
 
Arno KosterCommented:
Did you place the macro in a module ?

when used as above, the usedrange is not related to a specific worksheet and thus acts on the worksheet in which the macro is placed. When placed in a module, the code does not have a reference to the worksheet to be used.

so either :

- copy/paste the macro in a worksheet section in the vba editor
or
- add a reference to the required worksheet
eg:
Sub process_names()

With Worksheets("Sheet1")
    For Row = 1 To .UsedRange.Rows.Count
        If Len(.Range("N" & Row)) > 2 Then
            .Range("N" & Row) = .Range("N" & Row) & " " & Range("O" & Row)
            .Range("O" & Row) = .Range("P" & Row)
        End If
    Next Row
End With

End Sub

Open in new window

0
 
Arno KosterCommented:
or in your case : Worksheets("Data")
0
 
carlosabAuthor Commented:
Thanks. Making some progress. But, I still get a Runtime Error - Object required. When I debug, this is what I see. I've put the error location in the macro in Bold below:

Sub CopyFormulas()
    With Worksheets("Data")
        For Each Row In UsedRange.Rows
     '-- the F cell is the 6th cell in a row
          If Row.Cells(6) <> "" Then
            Row.Cells(1).Formula = Range("A1").Formula
            Row.Cells(2).Formula = Range("B1").Formula
            Row.Cells(3).Formula = Range("C1").Formula
            Row.Cells(4).Formula = Range("D1").Formula
            Row.Cells(5).Formula = Range("E1").Formula
          End If
        Next Row
    End With
End Sub

Here is all the Macros in the Module:

Sub Clean()
'
' Macro2 Macro
'

'
    Workbooks.OpenText Filename:= _
        "\\s2\shared\mailings\CVFILE.TXT", Origin:=437, StartRow _
        :=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 2), Array(2, 2), Array( _
        9, 2), Array(22, 1), Array(52, 1), Array(82, 1), Array(167, 1), Array(187, 1), Array(189, 1) _
        , Array(194, 1), Array(199, 5), Array(207, 9), Array(213, 1), Array(219, 1), Array(225, 1), _
        Array(231, 1), Array(237, 1), Array(243, 1), Array(249, 1), Array(254, 1), Array(265, 1), _
        Array(346, 1), Array(366, 1), Array(368, 1)), TrailingMinusNumbers:=True
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("S:S").Select
    Selection.Cut
    Range("D1").Select
    Selection.Insert Shift:=xlToRight
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Selection.Delete Shift:=xlToLeft
    Columns("J:Q").Select
    Selection.Delete Shift:=xlToLeft
    Columns("K:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:E").Select
    Selection.Cut
    Range("K1").Select
    ActiveSheet.Paste
    Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=True, Other:=False, FieldInfo:= _
        Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    Columns("M:M").Select
    Selection.Cut
    Range("L1").Select
    Selection.Insert Shift:=xlToRight
    Call CullRows
    Columns("D:D").Select
    Selection.Copy
    Range("A1").Select
    ActiveSheet.Paste
    Columns("D:D").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Columns("A:X").Select
    Selection.Copy
    Windows("DJ Mailings.xlsm").Activate
    Sheets("Data").Select
    Range("F1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Call Proper_Case
    Call CopyFormulas
    Call SortbyDefendant
End Sub
Sub CullRows()
    Dim rng1 As Range
    Dim lngRow As Long
    Application.ScreenUpdating = False
    If [a2] <> vbNullString Then
        Set rng1 = Range([a1], [a1].End(xlDown))
    Else
        Set rng1 = [a1]
    End If
    For lngRow = rng1.Rows.Count To 1 Step -1
        If Not (Cells(lngRow, "A") = "11" Or Cells(lngRow, "A") = "45") Then
            Rows(lngRow).EntireRow.Delete
        Else
            If Left$(Cells(lngRow, "c"), 2) <> "CV" Then Rows(lngRow).EntireRow.Delete
        End If
    Next
    Application.ScreenUpdating = True
End Sub
Sub CopyFormulas()
    With Worksheets("Data")
        For Each Row In UsedRange.Rows
     '-- the F cell is the 6th cell in a row
          If Row.Cells(6) <> "" Then
            Row.Cells(1).Formula = Range("A1").Formula
            Row.Cells(2).Formula = Range("B1").Formula
            Row.Cells(3).Formula = Range("C1").Formula
            Row.Cells(4).Formula = Range("D1").Formula
            Row.Cells(5).Formula = Range("E1").Formula
          End If
        Next Row
    End With
End Sub
Sub Proper_Case()
  Sheets("Data").Select
  Application.ScreenUpdating = False
' Loop to cycle through each cell in the specified range.
   For Each x In Range("A1:Z500")
      ' There is not a Proper function in Visual Basic for Applications.
      ' So, you must use the worksheet function in the following form:
      x.Value = Application.Proper(x.Value)
   Next
    Cells.Replace What:="Cv-", Replacement:="CV-", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="Lvnv", Replacement:="LVNV", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="Rgm", Replacement:="RGM", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="Llc", Replacement:="LLC", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="Ii", Replacement:="II", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
    Application.ScreenUpdating = True
End Sub
Sub process_names()

With Worksheets("Data")
    For Row = 1 To UsedRange.Rows.Count
        If Len(Range("N" & Row)) > 2 Then
            Range("N" & Row) = Range("N" & Row) & " " & Range("O" & Row)
            Range("O" & Row) = Range("P" & Row)
        End If
    Next Row

End With

End Sub
Sub SortbyDefendant()
'
' Macro4 Macro
'

'
    ActiveWorkbook.Worksheets("Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add Key:=Range("O:O"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Data").Sort
        .SetRange Range("A:AA")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("o:o").Select

End Sub
Sub SortByMagistrate()
'
' Macro5 Macro
'

'
    ActiveWorkbook.Worksheets("Data").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add Key:=Range("C:C"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Data").Sort
        .SetRange Range("A:AA")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Sub MoveNamesAndPrepForCallsToMagistrate()
'
' Macro9 Macro
'

    Sheets("Data").Select
    Columns("Q:R").Select
    Application.CutCopyMode = False
    Selection.Cut
    Range("I1").Select
    Selection.Insert Shift:=xlToRight
    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft
    Selection.ColumnWidth = 37.43
    Range("K1:K40").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A1").Select
    Range("I30:K30").Select
    Range("K30").Activate
    ActiveWindow.ScrollColumn = 1
    Columns("E:E").Select
    Selection.EntireColumn.Hidden = True
    Columns("G:G").Select
    Selection.EntireColumn.Hidden = True
End Sub

0
 
Arno KosterCommented:
Almost there, you made a typo :

the code

 with worksheets("data")
    .usedrange [...]
   .cells[...]
end with

translates to

worksheets("data").usedrange [...]
worksheets("data").cells[...]

but only if you include the leading dot (".")

otherwise is would translate to

worksheets("data")usedrange instead of  worksheets("data").usedrange
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.