VBA is executing across 2 files

cforrester1981

New Member
Joined
Aug 22, 2020
Messages
11
Office Version
  1. 2016
Platform
  1. Windows
I am at wits end. I have no idea what is going on here.

I have posted previously that I am a VBA noob and using macros to learn VBA but the bit of programming experience that I have clearly isn't helping me find the problem with my code.

Some context: My client uses our software to pull a variety of different reports. However, the limitation of the software means that the one piece of data they require is tied up in a text string within a cell. I want to create a macro-enabled Excel file with different buttons that will extract the data from each of the different report formats. I have managed (with the help of this forum) to work out how extract my data. However, before I extract the data, I need to create a column to put the data in.

Below is my code. The problem I am having is that after the unmerging of the cells (the report is generated with merged cells), I need to copy the contents of cell A1 in the target file to the cell B1 in the target file. The code is correctly selecting and copying cell A1. However, when it has to select cell B2, it somehow switches back to the macro file and then the paste instruction pastes the contents to that file instead. I've marked where the problem lies. I've also included some screenshots so that you can see the outcome

VBA Code:
Sub OpenFile()
    Dim StrFile As String
    Dim wb As Workbook
    
    StrFile = Application.GetOpenFilename(fileFilter:="Excel files (*.xls*), *.xls*", Title:="Choose an Excel file to open")
    Set wb = Workbooks.Open(StrFile)
        DoWork wb
        wb.Close SaveChanges:=True
End Sub
Sub DoWork(wb As Workbook)
    
    With wb
'   Unmerge all cells
    Cells.Select
    Selection.UnMerge
'   Copy Referring Doctor label to B1
    Range("A1").Select
    Selection.Copy
    Range("B1").Select '<-- PROBLEM LIES HERE!!!!
    ActiveSheet.Paste ' <-- AND HERE!!!!
'   Delete column A
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
'   Copy column B to column I (so that the cell formatting is able to be duplicated)
    Columns("B:B").Select
    Selection.Copy
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight
    Application.CutCopyMode = False
'   Clear contents of column I and add new heading
    Selection.ClearContents
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Practice Number"
'   Move column I and insert it between column A & B
    Selection.Cut
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
End Sub

Before.png
Before starting the macro

Select & Copy Works Correctly.png
The unmerge, select and copy work correctly

Its Pasted In The Wrong File.png
It's pasted the copied text in the wrong file. :mad:

I have even tried to use wb = ActiveWorkBook before the select and paste. That didn't work either.

If I get this last bit working, the rest of my code works and I can carry on.

Thanks again for all your help. This noob feels like a complete dunce. 🤡
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
Try this for your OpenFile procedure. It is based on the original definitely being an *.xls file

VBA Code:
Sub OpenFile()
    Dim StrFile As String
    Dim wb As Workbook
    
    StrFile = Application.GetOpenFilename(fileFilter:="Excel files (*.xls*), *.xls*", Title:="Choose an Excel file to open")
    Set wb = Workbooks.Open(StrFile)
        DoWork wb
        Application.DisplayAlerts = False
        wb.SaveAs Filename:=wb.FullName & "x", FileFormat:=xlOpenXMLWorkbook
        wb.Close
        Application.DisplayAlerts = True
End Sub


For my own benefit I wanted to pick up on a couple of points you raised earlier.

your number format was not what I wanted.
Yes, I missed that. The change for my code would be
Rich (BB code):
      .NumberFormat = "@"
      .NumberFormat = "0000000"


your code did not apply to every third line
Does that mean that your sample file is not fully representative? The sample file has a single blank line every third row in column B (which becomes column A). I used that information to put the Practice numbers in the new column B on the line above that blank in column A. For the sample file, my code resulted in exactly the same values in exactly the same rows in column B as mumps' code. Can you shed any light on that?
I just thought it more efficient to do the whole column at once rather than looping down the column one value at a time. :)

In the end I'm quite comfortable that you chose mumps code, though there still might be some benefit in using a bit of both. For example, to me there seems no need to copy a column to column I just to empty it and then move it back to be a new column B. And you can certainly still use two procedures if you want.
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

cforrester1981

New Member
Joined
Aug 22, 2020
Messages
11
Office Version
  1. 2016
Platform
  1. Windows
@Peter_SSs I'll be honest, I didn't try your code cos after reading it over, I thought that it was missing the loop. Apologies. However, I now also see that you inserted the column and copied the formatting across from the right, thus eliminating the need to copy it out, clear it and copy it back.

Remember that I am teaching myself VBA basics based on code generated by recording macros. The code you guys have used is not generated by the macro recorder so I would not have known the function CopyOrigin:=xlFormatFromRightOrBelow.

I will need to go evaluate, decipher and understand your application of the extraction to the entire range/column (I see it there in the WITH declaration). I'm not sure how it applies only to every third cell.

I have to admit that making use of a blend of the 2 provided solutions is quite enticing. I have 3 more reports (each with a different layout) and I have to build extraction mechanisms for each of them. I am certainly going to try and make use of what I have learnt here to do exactly that.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
I'll be honest, I didn't try your code ..
Definitely should not discount forum suggestions without trying. :cool:


The code you guys have used is not generated by the macro recorder so I would not have known the function CopyOrigin:=xlFormatFromRightOrBelow.
I got it from the macro recorder. below I have inserted a new column B and clicked the little paintbrush icon drop-down that appears when you insert a column.

1598268400450.png



BTW, here is my sample file as it is at the end of DoWork just before returning to the OpenFile procedure to save & close.

cforrester1981 Turnover Report.xls
ABCDEFGHI
1Referring practitionerPractice NumberNo groupingVisitsNew patientsA. TurnoverB. CashflowC. Total JournalsZ. Outstanding Debtors
2Referring practitioner : ABBAS M R (CPT)( Pr: 1500848)
3ABBAS M R (CPT)( Pr: 1500848)1500848ALL322683.66-200000
4322683.66-20000
5Referring practitioner : ABOO ,DR O( Pr: 1900188)
6ABOO ,DR O( Pr: 1900188)1900188ALL270130265021.42-169764.94259.490
7270130265021.42-169764.94259.49
8Referring practitioner : ABOO NIZAM( Pr: 1900196)
9ABOO NIZAM( Pr: 1900196)1900196ALL10739.13000
1010739.1300
11Referring practitioner : ADAM ,DR S( Pr: 0444456)
12ADAM ,DR S( Pr: 0444456)0444456ALL1334320.61-7566.200
131334320.61-7566.20
14Referring practitioner : ADKINS ,DR R( Pr: 0450855)
15ADKINS ,DR R( Pr: 0450855)0450855ALL10739.13-85000
1610739.13-8500
17Referring practitioner : AGAMBARAM ,DR V( Pr: 2205890)
18AGAMBARAM ,DR V( Pr: 2205890)2205890ALL302423706.15-9766.4900
19302423706.15-9766.490
20Referring practitioner : AHMED DR FA( Pr: 0508276)
21AHMED DR FA( Pr: 0508276)0508276ALL272121216.14-4534.070.470
22272121216.14-4534.070.47
23Referring practitioner : AKOONJEE ,DR YD( Pr: 1432389)
24AKOONJEE ,DR YD( Pr: 1432389)1432389ALL332217.39-11000
25332217.39-1100
July 2020 Doctors revenue
 

Watch MrExcel Video

Forum statistics

Threads
1,123,353
Messages
5,601,136
Members
414,430
Latest member
jtdinh205

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top