Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Simple VBA Excel Coding

Posted on 2011-03-13
10
Medium Priority
?
268 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 2
10 Comments
 
LVL 24

Expert Comment

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

Expert Comment

by:Arno Koster
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:Arno Koster
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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 19

Accepted Solution

by:
Arno Koster earned 2000 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:Arno Koster
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
 

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:Arno Koster
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:Arno Koster
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:Arno Koster
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

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

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

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

670 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