asked on
Need help to format Excel by VBA code
I have one Excel file in one folder (C:/Source). I have also on Macro enable excel file where i need to copy source data to Macro enabled file with formatting. I need your help to write Macro to get file from Source folder and paste to Output tab. I am attaching Input and Report file with sample data,
Can you please help me?
Source File
Desired Output
Input-FIle.xlsx
Report.xlsm
Do you have any control over the input file ?
If so, a power BI solution will be better than VBA (users will only need to click te refresh button in the ribbon).
In the input file:
1st, add a "Company column", its value will be an absolute reference to the company code (AR00 or BR10 in your case). Hide it.
2nd, insert 2 data-tables (one for each table).
3rd save and close.
In the report file:
Create 3 queries:
1st one will retrieve data from the 1st table (connection only).
2nd one will retrieve data from the 2nd table (connection only).
3rd one will merge queries 1 and 2 and load into a sheet.
See the attached samples.Input-FIle.xlsxReport.xlsx
ASKER
Thank you for the code. It's working fine with the sample file i have provided but did not work properly with another file (More data). Can you please take a look attached file?
Input-FIle_New.xlsx
Fabrice,
Thanks for the solution. I will take a look but i my have to stick with macro since we already another macro for other functionality.
Please replace the existing code with the following one and see if that works as desired.
Const strSourcePath As String = "C:\Source\"
Const strSourceFileName As String = "Input-File.xlsx"
Sub getDataFromFile()
Dim wbSource As Workbook
Dim wbDest As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim Rng As Range
Dim rngToCopy As Range
Dim LR As Long
Dim DLR As Long
Dim fso As Object
Dim Company As String
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(strSourcePath) Then
MsgBox "The Source folder was not found!", vbExclamation, "Folder Doesn't Exist!"
Exit Sub
ElseIf Not fso.FileExists(strSourcePath & strSourceFileName) Then
MsgBox "The Source File was not found!", vbExclamation, "Source File Not Found!"
Exit Sub
End If
Set wbDest = ThisWorkbook
Set wsDest = wbDest.Worksheets("Output")
wsDest.Range("A1").CurrentRegion.Offset(1).Clear
Set wbSource = Workbooks.Open(strSourcePath & strSourceFileName)
Set wsSource = wbSource.Worksheets(1)
LR = wsSource.Cells(Rows.Count, "B").End(xlUp).Row
For Each Rng In wsSource.Range("B2:B" & LR).SpecialCells(xlCellTypeConstants, 3).Areas
If Rng.Cells(1).Value = "Account" Then
Company = Split(Rng.Cells(1).Offset(-2, 0).Value, " ")(0)
Set rngToCopy = wsSource.Range(Rng.Cells(1).Offset(1, 0), Rng.Cells(1).End(xlToRight).End(xlDown))
DLR = wsDest.Cells(Rows.Count, "B").End(xlUp).Row + 1
rngToCopy.Copy wsDest.Range("B" & DLR)
wsDest.Range("A" & DLR).Value = Company
End If
Next Rng
wbSource.Close False
DLR = wsDest.Cells(Rows.Count, "B").End(xlUp).Row
wsDest.Range("A2:A" & DLR).SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C"
wsDest.Range("A2:A" & DLR).Value = wsDest.Range("A2:A" & DLR).Value
wsDest.Range("A1").CurrentRegion.Borders.Color = vbBlack
Application.ScreenUpdating = True
End Sub
ASKER
1. If we have more than one files with same name , is it possible to select file with last modify date as input file?
2. Also is it possible to copy input file as it is with different tab within Report file for backup?
ASKER
You're welcome!
You may try something like this...
Please remember to change the Source Folder Path and Source File Name on first two lines of the code if required.
Open in new window
In the attached, click the Run button to test the code.
Report.xlsm