Macro Help

[H.Schurch]

Dear Experts

I have a range in a spreadsheet set up with a macro that concatenates the
row and column headings and copies the number (if it is >0) in the cell
where the column heading and row heading meet to a new worksheet. A bit like
looking up a street directory. Sometimes I have to change the criteria and
want only numbers copied that are >10. I know how to change the macro to do
this. I now have to copy numbers that are > than minus 1. Because some of
the cells in the range are empty it still concatenates the empty cells the
row and column headings and copies them to the worksheet. How do I change
the command in the macro so it leaves empty cells alone and does not copy
the row &column headings. It needs to be something like if value > -1 and
the cell <>"" Then?

Any help greatly appreciated. I am using Excel 97

Below is the code I am using.

Sub DomTkr734()

Dim MColHeadingValue, MRowHeadingValue, MRow, MCol, MVal

Windows("Dispatch Fuel Tanker Analysis.xls").Activate

Sheets("Dom Tkr").Select

Range("E4").Select

MRow = ActiveCell.Row

MCol = ActiveCell.Column

MRowHeadingValue = Cells(MRow, 1)

MColHeadingValue = Cells(1, MCol)



----------------------------------------------------------------------------
----
Do While MRowHeadingValue <> ""

Do While MColHeadingValue <> ""

MVal = Cells(MRow, MCol).Value

If MVal > 0 Then (What goes in here?????????)

Windows("TankeringSummary.xls").Activate

Sheets("Dom Summary").Select

Range("A65535").Select

Selection.End(xlUp).Select

Selection.Offset(1, 0).Select

Selection.Value = MRowHeadingValue & "/" & MColHeadingValue

Selection.Offset(0, 1).Value = MVal

Windows("Dispatch Fuel Tanker Analysis.xls").Activate

Sheets("Dom Tkr").Select

End If

Cells(MRow, MCol + 1).Select

MCol = ActiveCell.Column


MColHeadingValue = Cells(1, MCol)

Loop

MCol = 5

Cells(MRow + 1, MCol).Select

MRow = ActiveCell.Row

MRowHeadingValue = Cells(MRow, 1)

MColHeadingValue = Cells(1, MCol)

Loop

Windows("TankeringSummary.xls").Activate

Range("C1").Select


End Sub

 

[Dave Peterson]

I think that this does what you want.

Option Explicit
Sub DomTkr734()

Dim MColHeadingValue As Variant
Dim MRowHeadingValue As Variant
Dim MRow As Long
Dim MCol As Long
Dim MVal As Variant
Dim NumberToCheck As Long 'always a counting number?

Dim DomTrkWks As Worksheet
Dim DomSumWks As Worksheet

Set DomTrkWks = Workbooks("Dispatch Fuel Tanker Analysis.xls") _
.Worksheets("dom trk")
Set DomSumWks = Workbooks("TankeringSummary.xls").Worksheets("Dom Summary")

'for testing
'Set DomTrkWks = Worksheets(1)
'Set DomSumWks = Worksheets(2)

NumberToCheck = Application.InputBox _
(Prompt:="copy all those > #, use 9999 to exit", Type:=1)

If NumberToCheck >= 9999 Then
MsgBox "Try later!"
Exit Sub
End If


With DomTrkWks
MRow = 4 '.Range("e4").row
MCol = 5 '.range("e4").column
MRowHeadingValue = .Cells(MRow, 1).Value
MColHeadingValue = .Cells(1, MCol).Value

Do While MRowHeadingValue <> ""
Do While MColHeadingValue <> ""
MVal = .Cells(MRow, MCol).Value
If Application.IsNumber(MVal) Then
If MVal > NumberToCheck Then
With DomSumWks.Cells(.Rows.Count, "A") _
.End(xlUp).Offset(1, 0)
.Value = MRowHeadingValue & "/" & MColHeadingValue
.Offset(0, 1).Value = MVal
End With
End If
End If

MCol = MCol + 1
MColHeadingValue = .Cells(1, MCol).Value
Loop

MCol = 5
MRow = MRow + 1
MRowHeadingValue = .Cells(MRow, 1).Value
MColHeadingValue = .Cells(1, MCol).Value

Loop
End With

Application.Goto DomSumWks.Range("c1")

End Sub

You can usually do most things without selecting/activating. You can just work
on the object directly.

And instead of using Windows(...), I set up two variables to represent the
worksheets. Then I could just do things against those worksheets.