Excel Macro VBA capture dynamic column

[Kaniguan1969]

Hi Expert,

I have an attendance sheet in Excel file that distributed to different department composed of (12 dept/users) and
it is stored or copied in one folder.This attendance is filled up daily by team leaders as attendance monitoring.
the transaction is located in sheet1. i need to capture the column A to G ( this is the information related to employee, fixed column)
then the columns where the users entered the hours rendered by employee the column label format is Day-Month.

For ex. Today is April 24 (24-Apr), i need to capture the previous day (23-Apr), then tomorrow is APril 25 (capture the 24-Apr transaction).

There is a master user/admin who monitor all those transaction. It collate/captured manually all those transaction entered by users.
I wanted to automate collating/gathering of those data using Excel VBA macro and paste to assign sheet(Raw Data) in the master/admin working file.


I have this codes but i need some changes and i would like to ask some help. after searching the records and found I retain the column A to G then delete the other columns while the columns pertaining to the date that found in search i need also to retain. may i ask you hep on how to do make it. Your help is very much appreciated. Thank you.

Bye, i have another thread from other forum.
http://www.excelforum.com/excel-prog...cs-column.html


sample:
retain the columns A to G then the delete the column H up to column L then retain column M. the columns will adjust.
Columns
----------------------18-Apr--19-Apr---20-Apr---21-Apr---22-Apr--23-Apr---24-Apr
A--B--C--D--E--F--G--H-------I---------J---------K--------L--------M--------N

result
----------------------23-Apr-
A--B--C--D--E--F--G--H--

     Dim wbUPH, wbTP As Workbook

      Dim wsUPH, wsTP As Worksheet

      Dim rng, cel As Range
      Dim Uphpath, date_find As String
      Dim Lrow As Long

   
      'Source data located

      Uphpath = "C:\APR'14 OPs Attendance.xlsx"
   

      With Application
          .DisplayAlerts = False
          .AskToUpdateLinks = False
      End With
   

      'Open Source Data
      Set wbUPH = Workbooks.Open(Uphpath)
      DoEvents
      Set wsUPH = wbUPH.Sheets("Sheet1")
   
      'Working File
      Set wbTP = ThisWorkbook

      Set wsTP = wbTP.Sheets("Raw Data")
   

      'Searching column
      With wsUPH
          Lrow = .Range("A" & Rows.Count).End(xlUp).Row
          Set rng = wsUPH.Range("H2:AK2")  'Need this code to become dynamic (column range)

          date_find = Format(Now() - 1, "d-mmm")

          Set c = rng.Find(What:=date_find, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, _
          SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False)
   
          If Not c Is Nothing Then
             .Columns("H:AI").Delete xlToLeft  'need also this code dynamics.

             .Range("A2:H" & Lrow).Copy wsTP.Range("A1")

          Else

             MsgBox "No records found"

          End If

   

      End With

   

      'Dump/copy to working file

      With Application

          .DisplayAlerts = True
      End With
   
      'Close Datasource
      wbUPH.Close   Dim wbUPH, wbTP As Workbook
    Dim wsUPH, wsTP As Worksheet
    Dim rng, cel As Range
    Dim Uphpath, date_find As String
    Dim Lrow As Long
 
    'Source data located
    Uphpath = "C:\APR'14 OPs Attendance.xlsx"
 
    With Application
        .DisplayAlerts = False
        .AskToUpdateLinks = False
    End With
 
    'Open Source Data
    Set wbUPH = Workbooks.Open(Uphpath)
    DoEvents
    Set wsUPH = wbUPH.Sheets("Sheet1")
 
    'Working File
    Set wbTP = ThisWorkbook
    Set wsTP = wbTP.Sheets("Raw Data")
 
    'Searching column
    With wsUPH
        Lrow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rng = wsUPH.Range("H2:AK2")  'Need this code to become dynamic
        date_find = Format(Now() - 1, "d-mmm")
        Set c = rng.Find(What:=date_find, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, _
        SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False)
 
        If Not c Is Nothing Then
           .Columns("H:AI").Delete xlToLeft
           .Range("A2:H" & Lrow).Copy wsTP.Range("A1")
        Else
           MsgBox "No records found"
        End If
 
    End With
 
    'Dump/copy to working file
    With Application
        .DisplayAlerts = True
    End With
 
    'Close Datasource
    wbUPH.Close

[SamT]

Not tested:

  Dim c As Long, i As Long
  '
  '
  '
  With wsUPH
    Lrow = .Range("A" & Rows.Count).End(xlUp).Row
    Set rng = wsUPH.Rows(2)
   date_find = Format(Now() - 1, "d-mmm")
   
    On Error Resume Next
    c = rng.Find(What:=date_find, LookIn:=xlValues).Column - 1
    Err = 0
    
    If c > 8 Then
     For i = c To 8 Step -1
      Columns(i).Delete
    Next i
      .Range("A:H").Copy wsTP.Range("A1")
      With wsTP.Rows(1)
        .Delete
        .Delete
      End With
    Else
         
        MsgBox "No records found"
         
    End If

[Kaniguan1969]

Its working now with a little bit changes on some codes.
Btw, I need this code to be dynamics instead of hard coded the columns.

Also, I need to check in the working file under column H if This
String "Line1" is already copied/dump.? may i know on how to make a coding.
I would place this codes before reading the source data if not yet exist then will proceed else i have to make a message that this Line1 is already exist. thanks.


place the code here before reading this code to evaluate if the strings "Line1" in column H is already copy/dump.

'Source data located Uphpath = "C:\APR'14 OPs Attendance.xlsx"

With wsUPH          Lrow = .Range("A" & Rows.Count).End(xlUp).Row

          Set rng = wsUPH.Range("H2:AK2")  'Need this code to become dynamic

          date_find = Format(Now() - 1, "d-mmm")

          
          On Error Resume Next
          Set c = rng.Find(What:=date_find, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, _
          SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False)

          Debug.Print c.Address

                

          If Not c Is Nothing Then

             .Range("H1", .Cells(1, c.Column - 1).Address).EntireColumn.Delete xlToLeft

             .Range("A2:H2" & Lrow).Copy wsTP.Range("A1")

          Else

             MsgBox "No records found"

          End If
      End With

[SamT]

Set rng = wsUPH.Range("H2:AK2") 'Need this code to become dynamic

Dynamic How? Different Row? Different Columns?