Getting type mismatch error when setting Worksheet.Name to a cell.value in VBA - excel

I have written the following code to create worksheet with names same as the names in first column of Sheet1
I am getting a TypeError when trying to set the name on the new worksheet but don't know why. Can someone help?
Sub CreateWorkSheets()
'
' Macro5 Macro
'
'
Dim r As Range
Set r = Sheets("Sheet1").Columns(1)
For Each cell In r
Dim aa As String
Dim newSheet As Worksheet
Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))
strTemp = cell.Value
newSheet.Name = strTemp // Error Here
Next cell
End Sub
I tried the following code as well and that doesn't work either even though strValue is valid
Sub Test1()
Sheets("Sheet1").Select
Dim x As Integer
' Set numrows = number of rows of data.
NumRows = Range("A2", Range("A2").End(xlDown)).rows.Count
' Select cell a1.
Range("A2").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
Dim newSheet As Worksheet
Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))
Sheets("Sheet1").Range("B1").Value = "A" + Trim(Str(x))
strValue = "A" + Trim(Str(x))
newSheet.Name = Str(Sheets("Sheet1").Range(strValue).Value)
Next
End Sub

Apparently because you set:
Set r = Sheets("Sheet1").Columns(1)
It set the cell object to column $A:$A instead of $A$1 like you would think. I put this in the immediate window when I ran into the "cell.value" line:
?cell.Address
$A:$A
You should avoid using an entire column to do what you're trying to do and I would highly recommend you add these keywords to the top of your module:
Option Explicit
This will check your code a little more thoroughly and help you avoid unwanted errors.
To fix this, you can get the exact range you need and I recommend you declare every variable so it stays a specific type.
Something like this:
Option Explicit
Sub CreateWorkSheets()
Dim r As Range
Dim sh As Worksheet
Dim tempSh As Worksheet
Dim cell As Range
Dim strTemp As String
Set sh = Sheets("Sheet1")
Set r = sh.Range(sh.Cells(1, 1), sh.Cells(sh.Rows.Count, 1).End(xlUp))
For Each cell In r
Set tempSh = Sheets.Add(After:=Sheets(Sheets.Count))
strTemp = cell.Value
tempSh.Name = strTemp '// no more error
Next cell
End Sub

Related

VBA Create and Rename Tables

I'm looking to create a table without selecting the first row and creating a table. Then naming the table based on what the sheet name is.
Sub ConvertDataToTables()
' For i = 3 To 5
' Sheets(i).Activate
' Rows(1).EntireRow.Delete
' Next i
For i = 3 To 5
On Error Resume Next
Sheets(i).Select
ActiveSheet.ShowAllData
Cells.AutoFilter
Range("A2").CurrentRegion.Select
If ActiveSheet.ListObjects.Count < 1 Then
ActiveSheet.ListObjects.Add.Name = ActiveSheet.Name
End If
Next i
Table names get place with an underscore with a space and I don't want that. so Sum Day = Sum_Day from my code. I also want to have the selection not choose the top row but everything below.
Convert Table to Excel Table (ListObject)
Option Explicit
Sub ConvertDataToTables()
Const FIRST_CELL As String = "A2"
Const FIRST_INDEX As Long = 3
Const LAST_INDEX As Long = 5
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet, rg As Range, fCell As Range, lo As ListObject
Dim i As Long, NewName As String
For i = FIRST_INDEX To LAST_INDEX
Set ws = wb.Worksheets(i)
If ws.ListObjects.Count = 0 Then
' Remove the auto filter.
If ws.AutoFilterMode Then ws.AutoFilterMode = False
NewName = Replace(Application.Proper(ws.Name), " ", "")
ws.Name = NewName
Set fCell = ws.Range(FIRST_CELL)
With fCell.CurrentRegion
Set rg = fCell.Resize(.Row + .Rows.Count - fCell.Row, _
.Column + .Columns.Count - fCell.Column)
End With
Set lo = ws.ListObjects.Add(xlSrcRange, rg, , xlYes)
lo.Name = NewName
End If
Next i
End Sub
Try the following code. It will replace spaces from the sheet names. Also, it doesn't use Select to rely on the ActiveSheet - for further reading refer to How to avoid using Select in Excel VBA
The code uses intermediate Range variables to define the range for the table. It starts at cell A2 (startCell) and uses the last cell of the CurrentRegion as endCell.
Dim sheetIndex As Long
For sheetIndex = 3 To ThisWorkbook.Worksheets.Count
With ThisWorkbook.Worksheets(sheetIndex)
If .ListObjects.Count = 0 Then
Dim startcell As Range, endCell As Range, tableRange As Range
Set startcell = .Cells(2, 1)
Set endCell = startcell.CurrentRegion.Cells(startcell.CurrentRegion.Cells.Count)
Set tableRange = .Range(startcell, endCell)
Debug.Print tableRange.Address
.ListObjects.Add(xlSrcRange, tableRange).Name = Replace(.Name, " ", "")
End If
End With
Next sheetIndex
Note that you should always use Option Explicit and declare all Variables and you should never use On Error Resume Next except for single statement where you know that they might fail (and you want to do the error handling by your own).

How can i apply remove alphabet function on active sheet loop?

Function StripChar(Txt As String) As String
With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "\D"
StripChar = .Replace(Txt, "")
End With
End Function
So i am trying to apply this function on bottom range via loop through cells
Sub Alphabetremove()
Dim ws As Worksheet
Dim Lastrow As Integer
Set ws = ActiveSheet
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("F2:F" & Lastrow).Select
With Selection
.Value = StripChar(.Value)
End With
End Sub
The issue is that you cannot run the function .Value = StripChar(.Value) on a range at once (as you tried) but only on a single cell. Therfore you need to loop from row 2 to LastRow and apply the function to each single cell.
Also note that row counting variables need to be of type Long because Excel has more rows than Integer can handle. Actually I recommend always to use Long instead of Integer as there is no benefit in using Integer in VBA.
Also if you set your worksheet to a variable ws you need to use this variable for all .Cells and .Range objects otherwise this is useless.
Option Explicit
Public Sub Alphabetremove()
Dim ws As Worksheet
Set ws = ActiveSheet 'better define a workseet by name unless you use the code for multiple worksheets:
'Set ws = ThisWorkbook.Worksheets("MySheet")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim Cell As Range
For Each Cell In ws.Range("F2:F" & LastRow)
Cell.Value = StripChar(Cell.Value)
Next Cell
End Sub
Finally I highly recommend you to read How to avoid using Select in Excel VBA and apply this to all of your code.

Hope below code is equivalent to Vlookup with formatting. any suggestions. Excel VBA

Below is the code which I came up to get all the source formating whenever I require a vlookup type operation in excel. I am also getting any formulas by this way. If there is a way to elimate the formula and get only the value and formating then it will be of great help.
Option Explicit
Sub finding()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("Sheet2")
Dim i As Integer
Dim FoundRange As Range
Dim sFoundRange As String
Dim range_to_copy As Range
Dim range_to_paste As Range
Dim ToFindString As String
For i = 2 To 9
ToFindString = ws.Cells(i, 1)
On Error Resume Next:
sFoundRange = ws1.Range("E1:E12").Find(ToFindString).Address
Debug.Print sFoundRange
Set range_to_copy = ws1.Range(Replace(sFoundRange, "E", "F"))
Set range_to_paste = ws.Range("B" & i)
range_to_copy.Copy
range_to_paste.PasteSpecial xlPasteAllUsingSourceTheme
Application.CutCopyMode = False
Next i
End Sub
In order to check if a cell contains a formula, you might use the worksheet function =FormulaText(). I did a test with the Formula property of a range, but this did not work. (Maybe you might check if the first character is a = sign)

Why do I keep getting an error in my code?

I'm attempting my first VBA code and I keep getting a run time error at this specific place in my code:
lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Here is the actual code:
Sub Test_loop()
' Testing loop for highlighting
Dim lastrow As Long
Dim datevar As String
lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
datevar = Format(ws.Cells(i, 2), "mm/dd")
If ws.Cells(i, 3) = "Received" And datevar = "11/24" Then
Cells(i, 1).Interior.Color = RGB(rrr, ggg, bbb)
End If
Next i
End Sub
My goal is to go though the last cell of my row and find a cell with a specific date that has a cell to the right with a specific text. Then it would highlight the first cell in that row and loop on to the next row. I'm not too sure where I went wrong and why I am getting an error.
would appreciate the help
The code is producing an error because ws isn't set to any actual worksheet. Here's how to fix this:
add Option Explicit as the first line in the module. This will let
Excel catch any undeclared variables
declare ws as a variable of
type Worksheet using a Dim statement. Also add declarations any
other variables that we use later - i, rrr, ggg, bbb
make ws point to an actual worksheet using a Set statement
Putting this together gives us:
Option Explicit
Sub Test_loop()
' Testing loop for highlighting
Dim lastrow As Long
Dim datevar As String
' These variables weren't declared in the original code
Dim ws As Worksheet
Dim i As Integer
Dim rrr As Integer
Dim ggg As Integer
Dim bbb As Integer
' ws needs to be set to an actual sheet - Sheet1 is used here
' but replace this with the name of the actual sheet you need
'
' ws will be set to the worksheet called Sheet1 in whichever
' workbook is active when the code runs - this might not be
' the same workbook that the code is stored in
Set ws = Worksheets("Sheet1")
' For consistency, need to qualify Rows.Count with
' a worksheet
lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
datevar = Format(ws.Cells(i, 2), "mm/dd")
If ws.Cells(i, 3) = "Received" And datevar = "11/24" Then
Cells(i, 1).Interior.Color = RGB(rrr, ggg, bbb)
End If
Next i
End Sub

Copy a Range using variables as arguments

I'm new to VBA and am having issues with Range syntax and what are acceptable arguments.
the purpose of this code is as follows:
user inputs value into cell D5 on Sheet2
User activates code with button
searches "configs" sheet for value
copies corresponding range after locating value
pastes range back into Sheet2
the range I am attempting to copy paste is a block that starts with the selected cell (D5) on sheet "Configs", and continues until an empty cell is found.
Sub search()
Dim GCell As Range,
Dim box As Integer
Dim Avio As String
Dim Sheet2 As Worksheet, Configs As Worksheet
Dim rw1 As String, rw2 As String
Set Configs = ActiveWorkbook.Sheets("Configs")
Set Sheet2 = ActiveWorkbook.Sheets("Sheet2")
Avio = Range("D5").Value
Set GCell = Configs.Cells.Find(Avio)
box = 0
LoopX:
box = box + 1
If GCell.Offset(box, 0).Value = "" Then
rw1 = GCell.Offset(1, -1).Address
rw2 = GCell.Offset(box, 2).Address
Configs.Range("rw1:rw2").Copy <-- this syntax doesnt seem to work...
Sheet2.Range("Avio.Offset(1,0)").Paste <-- I know this is wrong, but I would like the range to be pasted just below the selected cell on Sheet2
Else: GoTo LoopX
End If
End Sub
Is this helping?
Sub search()
Dim GCell As Range
Dim box As Integer
Dim Sheet2 As Worksheet, Configs As Worksheet
Dim rw1 As String, rw2 As String
Set Configs = ActiveWorkbook.Sheets("Configs")
Set Sheet2 = ActiveWorkbook.Sheets("Sheet2")
Dim rngAvio As Range
Set rngAvio = Sheet2.Range("D5")
Set GCell = Configs.Cells.Find(rngAvio.Value)
box = 0
Do While (GCell.Offset(box, 0).Value <> "")
box = box + 1
rw1 = GCell.Offset(1, -1).Address
rw2 = GCell.Offset(box, 2).Address
Configs.Range(rw1 & ":" & rw2).Copy rngAvio.Offset(1, 0)
Loop
End Sub

Resources