PDA

View Full Version : Excel Macro VBA capture dynamic column



Kaniguan1969
04-24-2014, 05:40 AM
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-programming-vba-macros/1006333-macro-capture-a-dynamics-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
04-24-2014, 07:23 AM
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
04-26-2014, 04:05 AM
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
04-26-2014, 04:25 AM
Set rng = wsUPH.Range("H2:AK2") 'Need this code to become dynamicDynamic How? Different Row? Different Columns?