Can anyone help me understand, then bodge this existing Macro.

[RockandGrohl]

Hi guys,

We have a sheet at work which is a very rudimentary tool to select adverts to run in local newspapers. What it does is display a list of 74 papers and then you select the row, click a macro button which opens an adselect window that displays a list of our products we can sell. We then select a couple products and commit the selections, this then takes the information and writes it to a file called "Advert Data 2018"

This should hopefully all make sense. Ok, so that's fine, you go through each paper 74 times and choose the 2 best adverts. With help of a very excellent member of this community we managed to bring together a process file that can look at each paper and determine the 2 best adverts based on a scoring criteria. This works excellently, but you had to input each paper in, then write down every possible product reference.


That process is done automatically via the macro behind the adselect button, and my boss, before he left on annual leave, quickly bodged together a rough 'n' ready macro that displays each paper and each tour reference like this:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Paper[/TD]
[TD]Reference[/TD]
[/TR]
[TR]
[TD]Andover[/TD]
[TD]123F12[/TD]
[/TR]
[TR]
[TD]Andover[/TD]
[TD]181G18[/TD]
[/TR]
[TR]
[TD]Andover[/TD]
[TD]19FG73[/TD]
[/TR]
[TR]
[TD]Andover[/TD]
[TD]002R02[/TD]
[/TR]
</tbody>[/TABLE]

ETC ETC.

It then outputs them into a new sheet called "Full Output"

The problem:

While this process works really well, you essentially have to click each individual paper, click the ad-select button, wait 30 seconds for it to do its thing, then don't do any selections and close them. This process alone takes a good hour, is incredibly tedious and manual, and in my opinion it's redundant as the macro behind the adselect does everything for you - so it's possible to get the data, just not to format it the way you want automatically... yet.

What the macro does is read the paper and pull through every possible product for each paper, then when you click a new paper and click the adselect button, it appends the list with the new paper, so Andover, then you would do Braintree, then Cheltenham etc etc until you run through the entire list.

This is the VBA behind the process that outputs to the "Full Output" tab:

Sub Macro2()'
' Macro2 Macro
'

'
Columns("A:B").Select
ActiveWorkbook.Worksheets("Full Output").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Full Output").Sort.SortFields.Add Key:=Range( _
"A2:A51"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Full Output").Sort.SortFields.Add Key:=Range( _
"B2:B51"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Full Output").Sort
.SetRange Range("A1:B51")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub




And finally, this is what I want:

With my limited VBA knowledge, I know that macro isn't the whole story. It doesn't seem to reference where it needs to open which leads me to believe there's a "macro2" reference in another macro.

But essentially this is what I want.

1. Open the first paper which doesn't have "SKIP" in column F, in adselect window (this then copies the advert name and all possible products into Full Output tab)
2. Close adselect window
3. Find next paper which doesn't have "SKIP"
4. Open this paper in adselect
5. Close adselect window
6. Repeat till the end of the list, then stop.

Is it possible to append the Module2 macro to look for the next eligible paper in the list, open it, then close it?

Thanks.

 

[RockandGrohl]

Found some more related macro:

Private Sub forowadd()


Dim fo As Worksheet, lastrow As Long
Set fo = Worksheets("Full Output")
Range("A2").Activate


'Remove previous rows


Do Until Cells(ActiveCell.Row, "A").Value = ""
If Cells(ActiveCell.Row, "A").Value = AdSelect.PapNam.Caption Then
ActiveCell.EntireRow.Delete xlUp
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop


For x = 1 To 75
If AdSelect.Controls("Tourno" & x).Caption <> "Tourno" Then
Cells(ActiveCell.Row, "A").Value = AdSelect.PapNam.Caption
Cells(ActiveCell.Row, "B").Value = AdSelect.Controls("Tourno" & x).Caption
ActiveCell.Offset(1, 0).Activate
End If
Next x


lastrow = Cells(Rows.Count, "A").End(xlUp).Row


fo.Sort.SortFields.Clear
fo.Sort.SortFields.Add Key:=Range("A2:A" & lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
fo.Sort.SortFields.Add Key:=Range("B2:B" & lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With fo.Sort
.SetRange Range("A2:B" & lastrow)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


Range("A:B").EntireColumn.AutoFit


End Sub






I cant' find the right syntax to close the window. Basically you click a button which opens a large window that has various control buttons and radio buttons for selections - what's the macro to close this window? The syntax to load it is:

Range("A3").Select
Load AdSelect
AdSelect.Show


But Unload Adselect doesn't do anything, and close.activewindow closes the workbook after the adselect window is manually closed. Cheers