IF THEN with a copy and dialog box

ojackiec

New Member
Joined
Dec 5, 2005
Messages
17
I was asked to create several macros for an in-house project since I have some (very limited) programming skills. I have done pretty well except for two things. I have a set of field logs that come in and need to have reports created. My problems are as follows:

1. I need to be able to take data entered through a user form (i.e. a leak value that might be a single number or a range) and filter the field log by that info. In other words, a tech will enter a value into the user form. The field log must then be filtered by that value and certain information placed in a new sheet. I can create the user form. I need help with the code to use that input to filter the field log and copy certain columns into a new sheet.

2. I have created a user form that allows the tech to insert his/her name, ID, etc. I have also created a header with the same titles. How do I get the input from the user form to show up in the header? (i.e. I have a header code that says "Technician Name:" "Technician ID:" etc. but need the actual input to enter in after the title.)

Thanks a bunch to anyone who can help.
 

Some videos you may like

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
1. The basic method is to record a macro and change the recorded value for a variable. eg. MyVariable = Textbox1.Value

2. Don't know what you mean by "header". If you mean the userform.Caption then
Me.Caption ="Technician Name:" & textbox2.Value & "Technician ID: " & texbox3.Value etc.
 

ojackiec

New Member
Joined
Dec 5, 2005
Messages
17
1) The problem with recording is that I don't currently have any data in my sheet. Let me explain. We have hundreds of sites that are monitored for leaks. Each site sends in a field log when the monitoring occurs once a month. These field logs have already been entered as excel files. Two ladies have been so kind as to go through and begin making all of the various versions of field logs look like I want them to. So, I am creating a macro that places a new menu on the menu bar where they can just run the reports from. That way, they can open each sheet independently and create the reports for that site/month.
So, I just need code that I can place into what I already have. I actually have four different reports that will be created but I know if I see it once, I can duplicate it and change it accordingly for each sheet.
Basically, what I need is the semantics of the code. I have been trying to learn but think the stress is bogging down my ability to retain. Here is how I expect it to lay out:

If (the value in column J falls within the range provided in the user form)
Then (copy the value in column A to sheet2-column A, copy the value from column C to sheet2-columnD, etc.)
Else (ignore the row and move to next)

The copy columns are different for each report that will be created. Like I said, I just don't know the actual language well enough to write the code properly.

2) Header as in header/footer. I had not placed .Value after my name. Thanks! It works beautifully now!
 

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
We seem to be in a "chicken and egg" situation. Going back to your original message, there is certainly scope for recording macros. In this case, the filter process. Other code can then be added.

The field log must then be filtered by that value and certain information placed in a new sheet. I can create the user form. I need help with the code to use that input to filter the field log and copy certain columns into a new sheet.


Have a look at this. Not exactly what you want, but does include code for transferring values from one sheet to another.

http://www.mrexcel.com/board2/viewtopic.php?t=150953&highlight=
 

ojackiec

New Member
Joined
Dec 5, 2005
Messages
17

ADVERTISEMENT

OK. Here's the code I have that isn't working. I used some of what you provided in the link along with what I already had. It gives me a "run-time error: 438 Object does not support this property or method" for

Code:
ToSheet.Cells(ToRow, 1).Value _
            FromSheet.Cells(FromRow, 1).Value

Here is the whole section of code:

Code:
Sub LeakLog()
'
' LeakLog Macro
'
'

'
   Dim ws As Worksheet
    
    Set ws = Worksheets.Add()
    ws.Name = "Leak Log"
    
    ActiveCell.FormulaR1C1 = "Component"
    Range("A1:C1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
    Selection.Font.Bold = True
    Range("A1:C1").Select
    ActiveCell.FormulaR1C1 = "COMPONENT"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "FIELD DATA"
    Range("D1:F1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
    Selection.Font.Bold = True
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Tag No."
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "Location"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "Type"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "LDAR Action"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "Value (ppm)"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "Date"
    Rows("2:2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    Range("A1:F1").Select
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Columns("B:B").ColumnWidth = 27
    Range("A2:F2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "REPAIR COMMENTS"
    With ActiveCell.Characters(Start:=1, Length:=15).Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("G2:H2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Selection.Merge
    Range("G2:H2").Select
    Range("A1:C1").Select
    
    Columns("D:D").ColumnWidth = 12
    Columns("D:D").Select
    Range("D2").Activate
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Columns("E:E").ColumnWidth = 10.71
    Columns("F:F").ColumnWidth = 13
    Columns("F:F").Select
    Range("F2").Activate
    Selection.NumberFormat = "m/d/yyyy"
    Columns("G:G").ColumnWidth = 17.71
    Columns("I:I").ColumnWidth = 17.29
    Columns("H:H").ColumnWidth = 26.29
    Range("G2:H2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With

'Find records from Field Log and copy to Leak Log
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim ToSheet As Worksheet
Dim ToRow As Long
Dim FindThis As Variant
Dim FoundCell As Object
Dim rg As Range

Application.Calculation = xlCalculationManual
Set FromSheet = ThisWorkbook.Worksheets("Log Sheet")
Set ToSheet = ThisWorkbook.Worksheets("Leak Log")
ToRow = 3

FindThis = InputBox("Please enter lowest screening value to find: ")
If FindThis = "" Then End

With FromSheet.Cells
    Set FoundCell = .Find(FindThis, LookIn:=xlValues)
    If Not FoundCell Is Nothing Then
        'FirstAddress = FoundCell.Address
        FromRow = FoundCell.Row
    Do
        ToSheet.Cells(ToRow, 1).Value _
            FromSheet.Cells(FromRow, 1).Value
        ToSheet.Cells(ToRow, 2).Value _
            FromSheet.Cells(FromRow, 5).Value
        ToSheet.Cells(ToRow, 3).Value _
            FromSheet.Cells(FromRow, 4).Value
        ToSheet.Cells(ToRow, 5).Value _
            FromSheet.Cells(FromRow, 10).Value
        ToSheet.Cells(ToRow, 6).Value _
            FromSheet.Cells(FromRow, 11).Value
        
        Names.Add "SCREEN: ", "=D & ToRow"
        Names.Add "REPAIR METHOD: ", "=G & ToRow"
        ToRow = ToRow + 1
        
        Names.Add "REPAIR: ", "=D & ToRow"
        Names.Add "DELAY REASON: ", "=G & ToRow"
        ToRow = ToRow + 1
        
        Names.Add "RESCREEN: ", "=D & ToRow"
        Names.Add "SHUTDOWN: ", "=G & ToRow"
        ToRow = ToRow + 1
        
        Set FoundCell = .FindNext(FoundCell)
    Loop While Not FoundCell Is Nothing 'And _
        'FoundCell.Address <> FirstAddress
    
    End If
End With

MsgBox ("Done.")
    
End Sub
[/code]

Thanks again for your help.
 

Von Pookie

MrExcel MVP
Joined
Feb 17, 2002
Messages
13,686
You're missing an equal sign.

Change this:
Code:
ToSheet.Cells(ToRow, 1).Value _
            FromSheet.Cells(FromRow, 1).Value

to this
Code:
ToSheet.Cells(ToRow, 1).Value = _
            FromSheet.Cells(FromRow, 1).Value
 

Von Pookie

MrExcel MVP
Joined
Feb 17, 2002
Messages
13,686

ADVERTISEMENT

Taking a better look at the code, you're going to run into some problems with the rest of the code after that, though. Range names can't contain spaces or symbols (such as "REPAIR: " or "DELAY REASON: ") and you dont' want the full "D & ToRow" in quotes--just the "=D" portion. Also, the search will result in an unending loop without the first-address check (at least it did for me).

Try this. I cleaned up the first part of the code as well--with a macro, you don't need to select the cells in order to work with them.

Code:
Sub LeakLog()
Dim ws As Worksheet
Dim ToSheet As Worksheet, FromSheet As Worksheet
Dim ToRow As Long, FromRow As Long
Dim FindThis As Variant, FoundCell As Object
Dim rg As Range, FirstAddress As String, i As Integer

Set ws = Worksheets.Add()

With ws
    .Name = "Leak Log"

    With .Range("A1:C1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .MergeCells = True
        .Font.Bold = True
        .Value = "COMPONENT"
    End With
    
    With .Range("A1:F1").Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    
    With .Range("A2:F2")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .MergeCells = False
        .Font.Bold = True
    End With

    .Range("A2").Value = "Tag No."
    .Range("B2").Value = "Location"
    .Range("C2").Value = "Type"
    .Range("D2").Value = "LDAR Action"
    .Range("E2").Value = "Value (ppm)"
    .Range("F2").Value = "Date"
    .Range("E1").Value = "FIELD DATA"
    
    With .Range("D1:F1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .MergeCells = True
        .Font.Bold = True
    End With
    
    .Columns("B:B").ColumnWidth = 27
        
    With .Range("G2")
        .Value = "REPAIR COMMENTS"
        With .Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 10
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
        End With
    End With
    
    
    .Columns("D:D").ColumnWidth = 12
    With .Range("D2")
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .ReadingOrder = xlContext
    End With
    .Columns("E:E").ColumnWidth = 10.71
    .Columns("F:F").ColumnWidth = 13
    .Range("F2").NumberFormat = "m/d/yyyy"
    .Columns("G:G").ColumnWidth = 17.71
    .Columns("I:I").ColumnWidth = 17.29
    .Columns("H:H").ColumnWidth = 26.29
    
    With .Range("G2:H2")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
End With

'Find records from Field Log and copy to Leak Log

Application.Calculation = xlCalculationManual
Set FromSheet = ThisWorkbook.Worksheets("Log Sheet")
Set ToSheet = ThisWorkbook.Worksheets("Leak Log")
ToRow = 3

FindThis = InputBox("Please enter lowest screening value to find: ")
If FindThis = "" Then End

With FromSheet.Cells
    Set FoundCell = .Find(FindThis, LookIn:=xlValues)
    If Not FoundCell Is Nothing Then
        FirstAddress = FoundCell.Address
        FromRow = FoundCell.Row
        Do
            ToSheet.Cells(ToRow, 1).Value = .Cells(FromRow, 1).Value
            ToSheet.Cells(ToRow, 2).Value = .Cells(FromRow, 5).Value
            ToSheet.Cells(ToRow, 3).Value = .Cells(FromRow, 4).Value
            ToSheet.Cells(ToRow, 5).Value = .Cells(FromRow, 10).Value
            ToSheet.Cells(ToRow, 6).Value = .Cells(FromRow, 11).Value
            Names.Add "SCREEN", "=D" & ToRow
            Names.Add "REPAIR_METHOD", "=G" & ToRow
            ToRow = ToRow + 1
            
            Names.Add "REPAIR", "=D" & ToRow
            Names.Add "DELAY_REASON", "=G" & ToRow
            ToRow = ToRow + 1
            
            Names.Add "RESCREEN", "=D" & ToRow
            Names.Add "SHUTDOWN", "=G" & ToRow
            ToRow = ToRow + 1
            
            Set FoundCell = .FindNext(FoundCell)
        Loop While Not FoundCell Is Nothing And _
        FoundCell.Address <> FirstAddress
    End If
End With

MsgBox ("Done.")

End Sub
 

ojackiec

New Member
Joined
Dec 5, 2005
Messages
17
That's wonderful! Thank you very much!

What if I wanted to find a range of values instead of a single value? For example, instead of searching for a screening value of 500, I wanted to find all screening values between 500 and 2000?

Thanks again!!
 

ojackiec

New Member
Joined
Dec 5, 2005
Messages
17
I'm having trouble with the

Code:
Names.Add "SCREEN", "=D" & ToRow
        Names.Add "REPAIR_METHOD", "=G" & ToRow
        ToRow = ToRow + 1
        
        Names.Add "REPAIR", "=D" & ToRow
        Names.Add "DELAY_REASON", "=G" & ToRow
        ToRow = ToRow + 1
        
        Names.Add "RESCREEN", "=D" & ToRow
        Names.Add "SHUTDOWN", "=G" & ToRow
        ToRow = ToRow + 1

The names aren't showing up as they should. It is skipping the required number of rows, though.
 

Von Pookie

MrExcel MVP
Joined
Feb 17, 2002
Messages
13,686
ojackiec said:
What if I wanted to find a range of values instead of a single value? For example, instead of searching for a screening value of 500, I wanted to find all screening values between 500 and 2000?

Add these variables to the list you already have:

Code:
Dim StartNum As Long, EndNum As Long, i As Long
(you'll need to delete the "i as integer" one that is already in there--I didn't realize I forgot to delete that when I first posted)

Then try:

Code:
Application.Calculation = xlCalculationManual
Set FromSheet = ThisWorkbook.Worksheets("Log Sheet")
Set ToSheet = ThisWorkbook.Worksheets("Leak Log")
ToRow = 3

On Error Resume Next
StartNum = InputBox("enter the starting number")
If StartNum = 0 Then End

EndNum = InputBox("enter the ending number")
If EndNum = 0 Then End

For i = StartNum To EndNum

    With FromSheet.Cells
        Set FoundCell = .Find(what:=i, LookIn:=xlValues, lookat:=xlWhole)
        If Not FoundCell Is Nothing Then
            FirstAddress = FoundCell.Address
            FromRow = FoundCell.Row
            Do
                ToSheet.Cells(ToRow, 1).Value = .Cells(FromRow, 1).Value
                ToSheet.Cells(ToRow, 2).Value = .Cells(FromRow, 5).Value
                ToSheet.Cells(ToRow, 3).Value = .Cells(FromRow, 4).Value
                ToSheet.Cells(ToRow, 5).Value = .Cells(FromRow, 10).Value
                ToSheet.Cells(ToRow, 6).Value = .Cells(FromRow, 11).Value
                Names.Add "SCREEN", "=D" & ToRow
                Names.Add "REPAIR_METHOD", "=G" & ToRow
                ToRow = ToRow + 1
               
                Names.Add "REPAIR", "=D" & ToRow
                Names.Add "DELAY_REASON", "=G" & ToRow
                ToRow = ToRow + 1
               
                Names.Add "RESCREEN", "=D" & ToRow
                Names.Add "SHUTDOWN", "=G" & ToRow
                ToRow = ToRow + 1
               
                Set FoundCell = .FindNext(FoundCell)
            Loop While Not FoundCell Is Nothing And _
            FoundCell.Address <> FirstAddress
        End If
    End With
Next i
 

Watch MrExcel Video

Forum statistics

Threads
1,119,137
Messages
5,576,299
Members
412,716
Latest member
Ardin
Top