Hi,
I am currently having difficulty writing out some VBA scripts to basically extract the columns that I need into the new file and save it separately.
Code below is what I have written but this doesn't work at all. Since I am new to vba programming can anyone enlighten me?
Here is what I have to do
1. I have 2 files, one called Template and the others that go by company name(I have about 200 of them)
2. Each data sheet from my clients have column headings that I don't necessarily need and only have to extract the columns and paste it into a new file that keeps
Template file's Column headings and from there the data is added to the sheet and saves.
Sub Clean()
Dim dbook As Workbook
Dim rngCri As Range
Dim rngTemp As Range
Dim N As Long
Dim wb As Workbook
N = 1
Do
tfile = "c:\" & "(" & N & ")" & ".xlsx"
tfile1 = "c:\" & "Original" & "(" & N & ")" & ".xlsm"
Set rngCri = ThisWorkbook.Sheets(1).Range("a1")
If InStr(1, rngCri.Text, "Status") Or InStr(1, rngCri.Text, "Matter Status") Or InStr(1, rngCri.Text, "Resolution") Or _
InStr(1, rngCri.Text, "Resolution Date") Then
rngCri.Text = "Claim_Status"
ElseIf InStr(1, celltxt, "Disease") Then
rngCri = "Disease_Type"
End If
On Error GoTo K:
Set dbook = Workbooks.Open(Filename:=tfile)
Set rngTemp = Range("a1")
Set celltxt1 = rngTemp.Text
Do
If InStr(1, celltxt1, "Status") Or InStr(1, celltxt1, "Matter Status") Or InStr(1, celltxt1, "Resolution") Or _
InStr(1, celltxt, "Resolution Date") Then
rngCri = "Claim_Status"
ElseIf InStr(1, celltxt1, "Disease") Then
rngCri = "Disease_Type"
End If
Set rngTemp = rngTemp.Offset(0, 1)
If rngTemp = "" Then Exit Do
Loop
Do
dbook.Activate
Set rngTemp = Range(Range("a1").Range("a1").End(xlToRight))
Set rngF = rngTemp.Find(What:=rngCri, LookAt:=xlWhole)
If rngF Is Nothing Then
Else
If rngF.Offset(1, 0) = "" Then
Else
Range(rngF.Offset(1, 0), rngF.Offset(1, 0).End(xlDown)).Copy
ThisWorkbook.Activate
rngCri.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
End If
If rngCri = "" Then Exit Do
Loop
Application.DisplayAlerts = False
dbook.Close True
ThisWorkbook.Save
ActiveWorkbook.SaveAs Filename:=tfile1
N = N + 1
If N = 6 Then Exit Do
Loop
K:
End Sub
I am currently having difficulty writing out some VBA scripts to basically extract the columns that I need into the new file and save it separately.
Code below is what I have written but this doesn't work at all. Since I am new to vba programming can anyone enlighten me?
Here is what I have to do
1. I have 2 files, one called Template and the others that go by company name(I have about 200 of them)
2. Each data sheet from my clients have column headings that I don't necessarily need and only have to extract the columns and paste it into a new file that keeps
Template file's Column headings and from there the data is added to the sheet and saves.
Sub Clean()
Dim dbook As Workbook
Dim rngCri As Range
Dim rngTemp As Range
Dim N As Long
Dim wb As Workbook
N = 1
Do
tfile = "c:\" & "(" & N & ")" & ".xlsx"
tfile1 = "c:\" & "Original" & "(" & N & ")" & ".xlsm"
Set rngCri = ThisWorkbook.Sheets(1).Range("a1")
If InStr(1, rngCri.Text, "Status") Or InStr(1, rngCri.Text, "Matter Status") Or InStr(1, rngCri.Text, "Resolution") Or _
InStr(1, rngCri.Text, "Resolution Date") Then
rngCri.Text = "Claim_Status"
ElseIf InStr(1, celltxt, "Disease") Then
rngCri = "Disease_Type"
End If
On Error GoTo K:
Set dbook = Workbooks.Open(Filename:=tfile)
Set rngTemp = Range("a1")
Set celltxt1 = rngTemp.Text
Do
If InStr(1, celltxt1, "Status") Or InStr(1, celltxt1, "Matter Status") Or InStr(1, celltxt1, "Resolution") Or _
InStr(1, celltxt, "Resolution Date") Then
rngCri = "Claim_Status"
ElseIf InStr(1, celltxt1, "Disease") Then
rngCri = "Disease_Type"
End If
Set rngTemp = rngTemp.Offset(0, 1)
If rngTemp = "" Then Exit Do
Loop
Do
dbook.Activate
Set rngTemp = Range(Range("a1").Range("a1").End(xlToRight))
Set rngF = rngTemp.Find(What:=rngCri, LookAt:=xlWhole)
If rngF Is Nothing Then
Else
If rngF.Offset(1, 0) = "" Then
Else
Range(rngF.Offset(1, 0), rngF.Offset(1, 0).End(xlDown)).Copy
ThisWorkbook.Activate
rngCri.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
End If
If rngCri = "" Then Exit Do
Loop
Application.DisplayAlerts = False
dbook.Close True
ThisWorkbook.Save
ActiveWorkbook.SaveAs Filename:=tfile1
N = N + 1
If N = 6 Then Exit Do
Loop
K:
End Sub