Posts by Brian Walters

Re: Copy Based On Column Criteria & Append To Another Sheet

The problem is that there aren't any headings and that the cells in rows 1-3 are merged. Replace this part of the code

rwPaste =Range("A65536").End(xlUp).Row + 1

with

rwPaste = Application.WorksheetFunction.Max(Range("A65536").End(xlUp).Row + 1, 4)

Re: Copy Based On Column Criteria & Append To Another Sheet

So on Sheet1 it is pasting in rows 1-3? Put a macro stop (select the line and press F9) on this line of the code

rwPaste = Range("A65536").End(xlUp).Row + 1

Then close the workbook and the macro will pause at this line. The press F8 to step through the code to see what the value of rwPaste is and why it is pasting in rows 1-3.

Re: Copy Based On Column Criteria & Append To Another Sheet

I have corrected the macro for the columns you want and when you open the workbook Sheet1 will have any information in it. If you close the workbook and reopen it you should see the information populated.

Re: Copy Based On Column Criteria & Append To Another Sheet

Replace your code with this

Public Sub Workbook_BeforeClose(Cancel As Boolean)
Dim a As Long, b As Long, rwPaste As Long
  Sheets("Client Info").Select
  For a = 12 To Application.WorksheetFunction.Min(Application.WorksheetFunction.Max(Range("A65536").End(xlUp).Row, 12), 100)
    Sheets("Client Info").Select
    If Len(Range("N" & a)) > 0 Or Len(Range("O" & a)) Or Len(Range("P" & a)) Or Len(Range("Q" & a)) Then
      Sheets("Sheet1").Select
        For b = 4 To Application.WorksheetFunction.Max(Range("A65536").End(xlUp).Row, 4)
           If Range("A" & b).Value = Sheets("Client Info").Range("A" & a).Value And Range("C" & b).Value = Sheets("Client Info").Range("E" & a).Value Then
              GoTo 10
           End If
        Next b
      Sheets("Sheet1").Select
        rwPaste = Range("A65536").End(xlUp).Row + 1
        Range("A" & rwPaste).Value = Sheets("Client Info").Range("A" & a).Value
        Range("B" & rwPaste).Value = Sheets("Client Info").Range("B" & a).Value
        Range("C" & rwPaste).Value = Sheets("Client Info").Range("E" & a).Value
        Range("D" & rwPaste).Value = Sheets("Client Info").Range("L" & a).Value
        Range("E" & rwPaste).Value = Sheets("Client Info").Range("M" & a).Value
        Range("F" & rwPaste).Value = Sheets("Client Info").Range("N" & a).Value
        Range("G" & rwPaste).Value = Sheets("Client Info").Range("O" & a).Value
        Range("H" & rwPaste).Value = Sheets("Client Info").Range("P" & a).Value
        Range("I" & rwPaste).Value = Sheets("Client Info").Range("Q" & a).Value
        Range("J" & rwPaste).Value = Sheets("Client Info").Range("R" & a).Value
        Range("K" & rwPaste).Value = Sheets("Client Info").Range("S" & a).Value
    End If
10
  Next a
  Sheets("Client Info").Select
  ActiveWorkbook.Save


End Sub

Now you can see exactly where the data from Client Info is getting pasted on Sheet1. You can change what goes where if I don't have it correct.

Re: Clear Cell If Shaded With Command Button

Try

Selection.Interior.ColorIndex = xlNone

Re: Macro to copy and paste date in next empty row

Change

Range("A1:K1").Copy

to

Range("A2:K2").Copy

Re: Duplicate A Master Sheet Changing Values With A Macro

I'm not sure if this is your problem or not. I had an issue once trying to add many new sheets to a workbook. If you look under the Microsoft Excel Objects of the VB editor you will see that your sheets are listed as Sheet1 (Your 1st sheet name), Sheet2 (Your 2nd sheet name), etc. When I would add a new sheet, it would appear as Sheet11 (New sheet name). Once I got to Sheet1111111 I would get an error. Below is code to rename the CodeName of a worksheet.

ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).Name = "Sht" & ActiveWorkbook.Sheets.Count

Hope this helps.

Re: Macro to copy and paste date in next empty row

Try this

Range("A1:K1").Copy
Range("A" & Range("A65536").End(xlUp).Row) + 1).PasteSpecial xlPasteValues
Range("A" & Range("A65536").End(xlUp).Row)).PasteSpecial xlPasteFormats

HTH

Re: Hide Rows Accross All Sheets

Try this

Sub HideRows() 
Dim WS as Worksheet
  For Each WS In ThisWorkbook.Worksheets
    WS.Select
    ActiveSheet.Unprotect Password:="admin" 
    On Error Resume Next 
    With Range("e4:e34") 
        .EntireRow.Hidden = False 
        For i = 1 To .Rows.Count 
            If WorksheetFunction.Sum(.Rows(i)) = 0 Then 
                .Rows(i).EntireRow.Hidden = True 
            End If 
        Next i 
        ActiveSheet.Protect Password:="admin" 
    End With 
  Next WS
End Sub

Make sure this code is in a module and not the code section for a particular sheet.

HTH

Re: Copy Based On Column Criteria & Append To Another Sheet

The attached .zip file contains a revised version of your file. I added a column on the Sheet1 worksheet for the column E information from the Client Info worksheet. I also deleted a lot of empty rows on the Client Info worksheet to reduce the size of the workbook. You can test the macro by putting in a new client number, date and something in N-Q. The macro runs upon closing the workbook. Let me know if you have any problems.

Re: Unprotect Last Sheet After Deactivate, Custom Sort, Then Renable Protection

Try this

Public Sub data_global(WS As Worksheet)
    With WS
        .Unprotect "password"  '*** set this password to whatever you desire
        .Range("B4:M34").Sort Key1:=.Range("B4"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        .Protect "password"    '*** set this password to whatever you desire
    End With
End Sub

HTH

Re: Copy Based On Column Criteria & Append To Another Sheet

What distinguishes one row from the next on the Client Info sheet? For example, if column A is a client account number and column B is a transaction date and there can never be a client number with two rows having the same transaction date, then we could copy rows on the Client Info sheet whose client number - transaction date combination does not appear on Sheet1.

Re: Copy Based On Column Criteria & Append To Another Sheet

If the data sheet will hold 1 year's worth of data (or maybe better yet the year-to-date data?) then is it possible to just replace everything in Sheet1 with any rows on Client Info with data in cells N-Q? Or if a match must be done, are there a limited number of fields that could be used to match on Sheet1 to see if the row has already been copied?

Re: Copy Formula 1 Column Plus Two Associated Columns Maintain Relationship

Look into the Offset function. I have attached a workbook that should help.

Re: Parsing Data String

Try =Value(Mid(A1,6,5))

Re: Macro Delete Rows If 7 Rows Exist

Try this to keep those with 7 or more lines

Sub Keep7()
Dim rw As Long, cnt As Long
     
    cnt = 1
    For rw = Range("A65536").End(xlUp).Row - 1 To 1 Step -1
        If Range("A" & rw).Value = Range("A" & rw + 1).Value Then
            cnt = cnt + 1
        Else
            If cnt < 7 Then Rows(rw + 1 & ":" & rw + cnt).Delete
            cnt = 1
        End If
        If rw = 1 And cnt < 7 Then Rows(rw & ":" & rw + cnt).Delete
         
    Next rw
End Sub

Re: Copy From Current Row To Varriable Row

This code should work

Sub Loop1()
Dim CurrRow As Long, ColDCell As Range
   Range("A2").Select


    Do
        CurrRow = ActiveCell.Row
        Set ColACell = Cells(CurrRow, Columns("A").Column)
        Set ColCCell = Cells(CurrRow, Columns("C").Column)
        Set ColDCell = Cells(CurrRow, Columns("D").Column)
        Set ColECell = Cells(CurrRow, Columns("E").Column)
        If IsEmpty(ColDCell) = True Then Exit Sub
        If IsEmpty(ColCCell) = True Then
            Cells(CurrRow, 4).Copy Destination:=Cells(Range("A" & CurrRow).End(xlUp).Row, 5)
            Cells(CurrRow, 1).Offset(1, 0).Select
        Else
            Cells(CurrRow, 1).Offset(1, 0).Select
        End If
    Loop Until IsEmpty(ColDCell)
End Sub

Re: Copy Data Current Worksheet Vba

The .zip file is empty.

Re: Macro Delete Rows If 7 Rows Exist

Try this:

Sub RunIt()
Dim rw As Long, cnt As Long


  cnt = 1
  For rw = Range("A65536").End(xlUp).Row - 1 To 1 Step -1
    If Range("A" & rw).Value = Range("A" & rw + 1).Value Then
      cnt = cnt + 1
    Else
      If cnt >= 7 Then Rows(rw + 1 & ":" & rw + cnt).Delete
      cnt = 1
    End If
  
  Next rw






End Sub

HTH

Re: Copy From Current Row To Varriable Row

Can you post a sample of the data currently and then how you want it to look?