VBA Help Please..

T-rev

New Member
Joined
Aug 19, 2011
Messages
34
Ok so... within my worksheet are 4 macros, 12 worksheets and multiple data queries on 11 of the worksheets

what i am trying to do, is generate a master list of stocks listed on the ASX.

so i have one worksheet which data queries the information on how the individual sectors are performing (10 in total)

and 10 sheets with data queries showing me a summary of each individual company within each sector..

The aim is to generate a Master List showing me every stock listed on the ASX

the macros i have to do this are...

1. (this clears the master list for updating after i refresh every data query)

Private Sub CommandButton2_Click()

'

' ClearMaster Macro
'
Application.ScreenUpdating = False
Range("A3:K3000").Select
Selection.ClearContents
Range("A3").Select
Application.ScreenUpdating = True
End Sub

2. (This populates the master list again with the refreshed data)

Private Sub CommandButton1_Click()


'Create New Master List


Dim Ws As Worksheet

Dim LR As Long 'used to get the last row of data on each data sheet

With Sheets("Stock Picker") 'put the name of your master sheet here

.UsedRange.Offset(2).ClearContents 'remove data, leave titles in row 1

For Each Ws In Worksheets

If Ws.Name <> .Name Then 'skip the master sheet, use all others
LR = Ws.Range("A" & Ws.Rows.Count).End(xlUp).Row
Ws.Range("A5:K" & LR).Copy .Range("A" & .Rows.Count).End(xlUp).Offset(2)
End If
Next Ws
End With

End Sub


3. (This formats the data for my viewing pleasure :)


Sub CommandButton3_Click()
'
' FormatMasterList Macro
'
Application.ScreenUpdating = False
Rows("3:35").Select
Selection.Delete

Range("A3:Q3").Select
Application.CutCopyMode = False
Selection.Copy
Range("A4:Q3000").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Dim DeleteValue1 As String
Dim DeleteValue2 As String
Dim rng As Range
Dim calcmode As Long

With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
End With

'Fill in the two values that you want to delete
DeleteValue1 = "0"
DeleteValue2 = ""

'Sheet with the data, you can also use Sheets("MySheet")
With ActiveSheet

'Firstly, remove the AutoFilter
.AutoFilterMode = False

'Apply the filter
.Range("D3:D" & .Rows.Count).AutoFilter Field:=1, _
Criteria1:=DeleteValue1, Operator:=xlOr, Criteria2:=DeleteValue2

With .AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With

'Remove the AutoFilter
.AutoFilterMode = False
End With

With Application
.ScreenUpdating = True
.Calculation = calcmode
End With

End Sub



4. (This generates formulas so i can filter it and search the data based on my specifications)

Sub CommandButton3_Click()
'
' FormatMasterList Macro
'
Application.ScreenUpdating = False
Rows("3:35").Select
Selection.Delete

Range("A3:Q3").Select
Application.CutCopyMode = False
Selection.Copy
Range("A4:Q3000").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Dim DeleteValue1 As String
Dim DeleteValue2 As String
Dim rng As Range
Dim calcmode As Long

With Application
calcmode = .Calculation
.Calculation = xlCalculationManual
End With

'Fill in the two values that you want to delete
DeleteValue1 = "0"
DeleteValue2 = ""

'Sheet with the data, you can also use Sheets("MySheet")
With ActiveSheet

'Firstly, remove the AutoFilter
.AutoFilterMode = False

'Apply the filter
.Range("D3:D" & .Rows.Count).AutoFilter Field:=1, _
Criteria1:=DeleteValue1, Operator:=xlOr, Criteria2:=DeleteValue2

With .AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With

'Remove the AutoFilter
.AutoFilterMode = False
End With

With Application
.ScreenUpdating = True
.Calculation = calcmode
End With

End Sub



Column Headers are as follows...

A(Stock Code) B(Last Price) C(Change) D(Market Cap) E(52-Wk High)
F(52-Wk Low) G(EPS) H(Earn Yield) I(P/E).... the rest are for formulas.

My Latest Dilema is that Macro 2 used to copy the market summare page as it is set to copy all pages other than the master. hence the delete rows(3:35) in macro 3. it has now stopped copying these as far as i can see.. and on the master sheet (the row count on the left hand side numbers 1,2,31,91,108,117,141,205..and so on.. which it never used to.

any help would be greatly appreciated, sorry for the long post...and for being a total newb/hack @ VBA.
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
I just copied this to a new worksheet and everything seems to work perfectly.

if anyone has tips/advice on helping to streamline some of my code though it would be greatly appreciated,

if not feel free to ignore my previous post :)
 
Upvote 0
Sections 3 and 4 are identical, both say for CommandButton3.

You can shorten the Recorder based code for CommandButton2 to this:
Code:
Private Sub CommandButton2_Click()
    Range("A3:K3000").ClearContents
End Sub
No need to select cells to work with them, speeds code measurably.
 
Upvote 0
As far as the left hand side numbers skipping rows, it sounds like you either still have a filter applied, or you have hidden rows.
Does some of your code that is not shown hide rows?
 
Upvote 0
Thanks John :) i had fixed the command button numbering when i copied the worksheet to a new one, sorry about that.

i am still however encountering issues with


Code:
Private Sub CommandButton2_Click()
'Create New Master List

Dim Ws As Worksheet
Dim LR As Long      'used to get the last row of data on each data sheet

With Sheets("Stock Picker")                   'put the name of your master sheet here
    
    
    For Each Ws In Worksheets
        If Ws.Name <> .Name Then        'skip the master sheet, use all others
            LR = Ws.Range("A" & Ws.Rows.Count).End(xlUp).Row
            Ws.Range("A5:K" & LR).Copy .Range("A" & .Rows.Count).End(xlUp).Offset(2)
        End If
    Next Ws
End With

End Sub

Any ideas on how to fix this? perhapse even Data Link it? or to copy multiple data tables from different sheets of my choice, rather than all but the Master?
 
Upvote 0
What issues are you having with that code?

I ran it on a test workbook and it did what I think you are doing.
 
Upvote 0
sorry, i found the problem, it wasn't the code, it was the data query itself, wasnt linking to the site properly hence there was no data stored in the table for the code to work with for some sheets. or they may have pulled the site down for updates/maintenance as i refreshed the query, i'm unsure exactly how it came to be..

thanks for your help though :)
 
Upvote 0

Forum statistics

Threads
1,224,599
Messages
6,179,827
Members
452,946
Latest member
JoseDavid

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
Back
Top