Solved

Simple VBA Excel Coding

Posted on 2011-03-13
10
242 Views
Last Modified: 2012-06-21
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.
0
Comment
Question by:carlosab
  • 7
  • 2
10 Comments
 
LVL 24

Expert Comment

by:StephenJR
ID: 35127465
Can you post a workbook?
0
 
LVL 19

Expert Comment

by:akoster
ID: 35129653
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
 
LVL 19

Expert Comment

by:akoster
ID: 35129714
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
 
LVL 19

Accepted Solution

by:
akoster earned 500 total points
ID: 35129769
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
 
LVL 19

Expert Comment

by:akoster
ID: 35129832
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Comment

by:carlosab
ID: 35137662
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
 
LVL 19

Expert Comment

by:akoster
ID: 35146971
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
 
LVL 19

Expert Comment

by:akoster
ID: 35146974
or in your case : Worksheets("Data")
0
 

Author Comment

by:carlosab
ID: 35181620
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
 
LVL 19

Expert Comment

by:akoster
ID: 35190634
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

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

932 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now