'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
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

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 |
