Link to home
Start Free TrialLog in
Avatar of carlosab
carlosab

asked on

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.
Avatar of StephenJR
StephenJR
Flag of United Kingdom of Great Britain and Northern Ireland image

Can you post a workbook?
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

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

ASKER CERTIFIED SOLUTION
Avatar of Arno Koster
Arno Koster
Flag of Netherlands image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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
Avatar of carlosab
carlosab

ASKER

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
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

or in your case : Worksheets("Data")
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

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