'VBA problem creating pop up box to select data to copy in other spreadsheet

I need to open a CSV file (semicolonseparated.txt), where the user can type a number to put in sheet (in A1) containing data from (semicolonseparated.txt) a range (A2:i2) to copy to the memory for the user to insert elsewhere with "CTRL V". When I put together the code blocks, it will not copy the range specified.

The code is as follows:

Sub SemicolonSep()
    Dim sPath As String
    sPath = ThisWorkbook.Path & "\semicolonseparated.txt"
    Workbooks.OpenText Filename:= _
        sPath, DataType:=xlDelimited, Semicolon:=True, Local:=True

    On Error Resume Next
    Dim dblAmount As Double
    dblAmount = InputBox("Please enter the required amount", "Enter Amount")
    Windows("semicolonseparated.txt").Activate

    If dblAmount = 1 Then
        Windows("semicolonseparated.txt").Activate
        Sheets("semicolonseparated").Select
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "1"
        Range("B1:J1").Select
        Selection.Copy
    Else
        If dblAmount = 2 Then
            Windows("semicolonseparated.txt").Activate
            Sheets("semicolonseparated").Select
            Range("A1").Select
            ActiveCell.FormulaR1C1 = "2"
            Range("B2:J2").Select
            Selection.Copy
        Else
            MsgBox "You did not enter a number!"
        End If
    End If
End Sub

I hope you can help me :-) Jacob

vba


Solution 1:[1]

Read Avoid using SELECT or ACTIVATE

Application.InputBox allows you to specify the input type.

Refactored Code

Sub SemicolonSep()
    On Error Resume Next
    Dim dblAmount As Double
    dblAmount = Application.InputBox(Prompt:="Please enter the required amount", Title:="Enter Amount", Type:=1)
    
    Dim DataFile As Workbook
    Set DataFile = GetDataFile
    
    ThisWorkbook.Activate
    
    With DataFile.Worksheets(1)
        Select Case dblAmount
        Case 1
            .Range("A1").Value = dblAmount
            .Range("B1:J1").Copy
        Case 2
            .Range("A1").Value = dblAmount
            .Range("B2:J2").Copy
        Case Else
            MsgBox "Value Must be 1 or 2"
        End Select
    
    End With
End Sub

Function GetDataFile() As Workbook
    Dim sPath As String
    sPath = ThisWorkbook.Path & "\semicolonseparated.txt"
     Workbooks.OpenText Filename:=sPath, DataType:=xlDelimited, Semicolon:=True, Local:=True
    Set GetDataFile = ActiveWorkbook
End Function

Note: I revised my code because GetDataFile had an error.

FunThomas mentioned that there are issues with equality using Double precision. Technically, if the value will always be an integer the variable should use the Long data type. Double is precise for up to 15 significant figures with 14 decimal places.

Exert form VBA Numbers - Double

This can support 15 significant figures with 14 decimal places. If you need greater precision (with less or no rounding errors) then you should use the Decimal

Immediate Window

Solution 2:[2]

This code will not copy range B2:J2 from the source "semicolonseparated". Pop up box display selected range though. Any suggestions?

 Sub SemicolonSep()
On Error Resume Next Me.Unprotect Dim sPath As String sPath = ThisWorkbook.Path & "\semicolonseparated.txt" Workbooks.OpenText Filename:= _ sPath, DataType:=xlDelimited, Semicolon:=True, Local:=True

Dim dblAmount As Double
dblAmount = Application.InputBox(Prompt:="Vælg virksomhed ved at taste linjenummer", Title:="Data fra BioReg", Type:=1)

Dim DataFile As Workbook
Set DataFile = GetDataFile
'Workbooks("semicolonseparated").Close SaveChanges:=False
'ThisWorkbook.Activate
Workbooks("semicolonseparated").Activate
    'With DataFile.Worksheets(1)    With DataFile.ActiveSheet
    Select Case dblAmount
    Case 1
        .Range("A2").Value = dblAmount
        ActiveSheet.Range("B2:J2").Select
        Selection.Copy
        MsgBox " " & vbCrLf _
        & ActiveSheet.Range("b2").Value & vbCrLf

    Case 2
        .Range("A3").Value = dblAmount
        ActiveSheet.Range("B3:J3").Copy
        MsgBox " " & vbCrLf _
                    & Range("b2").Value & vbCrLf

    Case Else
        MsgBox "Value Must be 1 to 10"
    End Select

End With

Me.Protect End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1
Solution 2 Jacob Hofman-Bang