runtime error 13 type mismatch

joishe

New Member
Joined
Mar 3, 2021
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
Hi ,

I have purchased a macro. it works fine of some sheets and on others it gives me the following error. "runtime error 13" type mismatch. These are the lines that cause the problem.
VBA Code:
ws.Range("F3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(showCArr)
ws.Range("G3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(showEArr)
ws.Range("N3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(showKArr)
ws.Range("O3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(showMArr)
I have to say that all the sheets are very similar in content. what could cause such a problem. is there a blanket solution for all runtime errors type mismatches??
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,406
Office Version
  1. 365
Platform
  1. Windows
At a guess the uniNameArr array is empty
 

joishe

New Member
Joined
Mar 3, 2021
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
thank-you for responding. how can if this be fixed?
here is the whole macro.
what is does is, it copies info from any two chosen sheets and then places them in a table, and has an interactive cell, then when pushed displays data on the copies of the sheets.
part of where it gets stuck, seems like, part of the data needs transposing, like if a reps name is spelled on the sheets as Davis, Sean on the table it transposes as Sean Davis.

Any ideas?

VBA Code:
Sub processData()

Application.ScreenUpdating = False
Application.EnableEvents = False

'declaration of variables
Dim wb As Workbook, wb1 As Workbook, wb2 As Workbook
Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet
Dim sfile1 As String, sfile2 As String
Dim uniqueCol As Integer
Dim i As Integer
Dim lr1 As Long, lr2 As Long
Dim rawNameArr1 As Variant, rawNameArr2 As Variant
Dim uniNameArr() As Variant
Dim cleanName As String
Dim uniPos As Integer
Dim newlr As Long
Dim rawClientArr1 As Variant, rawClientArr2 As Variant
Dim t1c1 As Variant, t1c2 As Variant, t2c1 As Variant, t2c2 As Variant
Dim j As Long
Dim tempArr() As Variant
Dim tempPos As Byte
Dim repCount As Byte
Dim showC As String, showE As String, showK As String, showM As String
Dim showCArr As Variant, showEArr As Variant, showKArr As Variant, showMArr As Variant
Dim myMsg As Byte

myMsg = MsgBox(Prompt:="Do you want to continue?", Title:="Run Macro", Buttons:=vbYesNo)

If myMsg <> 6 Then Exit Sub

Set wb = ThisWorkbook

stemp.Visible = xlSheetVisible

sfile1 = getFileName(sctrl.Range("file1").Value)
sfile2 = getFileName(sctrl.Range("file2").Value)

'check if filename already exists
If ifSheetExists(sfile1) Or ifSheetExists(sfile2) Then
    MsgBox Prompt:="Filename already found as sheet in this workbook." & vbNewLine & vbNewLine _
        & "Rename the files to be pulled.", Title:="Duplicate Sheet"
    Exit Sub
End If

sfile1 = sctrl.Range("file1").Value
sfile2 = sctrl.Range("file2").Value

'duplicate template sheet
stemp.Copy After:=wb.Sheets(wb.Sheets.Count)
Set ws = wb.Sheets(wb.Sheets.Count)
ws.Name = "PLELIM CHART" & countPlelimSheets

'open workbook1 and transfer data
Set wb1 = Workbooks.Open(Filename:=sfile1)
wb1.Sheets(1).Copy After:=wb.Sheets(wb.Sheets.Count)
Set ws1 = wb.Sheets(wb.Sheets.Count)
ws1.Name = getFileName(sfile1)
wb1.Close SaveChanges:=False

'open workbook2 and transfer data
Set wb2 = Workbooks.Open(Filename:=sfile2)
wb2.Sheets(1).Copy After:=wb.Sheets(wb.Sheets.Count)
Set ws2 = wb.Sheets(wb.Sheets.Count)
ws2.Name = getFileName(sfile2)
wb2.Close SaveChanges:=False

'label file names into column P of new PLELIM sheet
ws.Range("tfile1").Value = ws1.Name
ws.Range("tfile2").Value = ws2.Name

uniqueCol = ws.Range("tfile1").Offset(0, 2).Column

lr1 = ws1.Range("C" & Rows.Count).End(xlUp).Row
lr2 = ws2.Range("C" & Rows.Count).End(xlUp).Row

'get unique names for sheet1
rawNameArr1 = Application.Transpose(ws1.Range("C2:C" & lr1).Value)

'clean sales rep name (remove after semi-colon)
For i = LBound(rawNameArr1) To UBound(rawNameArr1)
    If InStr(1, rawNameArr1(i), ";") > 0 Then
        rawNameArr1(i) = Left(rawNameArr1(i), InStr(1, rawNameArr1(i), ";") - 1)
    ElseIf InStr(1, rawNameArr1(i), "&") > 0 Then
        rawNameArr1(i) = Left(rawNameArr1(i), InStr(1, rawNameArr1(i), "&") - 2)
    End If
Next i

For i = LBound(rawNameArr1) To UBound(rawNameArr1)

    If InStr(1, rawNameArr1(i), ";") > 0 Then
        cleanName = Left(rawNameArr1(i), InStr(1, rawNameArr1(i), ";") - 1)
    ElseIf InStr(1, rawNameArr1(i), "&") > 0 Then
        cleanName = Left(rawNameArr1(i), InStr(1, rawNameArr1(i), "&") - 2)
    Else
        cleanName = rawNameArr1(i)
    End If

    If i = 1 Then
    
        ReDim Preserve uniNameArr(0)
        uniNameArr(0) = cleanName
        uniPos = 1
        
    Else
    
        If Not IsInArray(rawNameArr1(i), uniNameArr) Then
    
            ReDim Preserve uniNameArr(uniPos)
            uniNameArr(uniPos) = cleanName
            uniPos = uniPos + 1
            
        End If
    
    End If

Next i

'get unique names for sheet2
rawNameArr2 = Application.Transpose(ws2.Range("C2:C" & lr2).Value)

'clean sales rep name (remove after semi-colon)
For i = LBound(rawNameArr2) To UBound(rawNameArr2)
    If InStr(1, rawNameArr2(i), ";") > 0 Then
        rawNameArr2(i) = Left(rawNameArr2(i), InStr(1, rawNameArr2(i), ";") - 1)
    ElseIf InStr(1, rawNameArr2(i), "&") > 0 Then
        rawNameArr2(i) = Left(rawNameArr2(i), InStr(1, rawNameArr2(i), "&") - 2)
    End If
Next i

For i = LBound(rawNameArr2) To UBound(rawNameArr2)

    If InStr(1, rawNameArr2(i), ";") > 0 Then
        cleanName = Left(rawNameArr2(i), InStr(1, rawNameArr2(i), ";") - 1)
    ElseIf InStr(1, rawNameArr2(i), "&") > 0 Then
        cleanName = Left(rawNameArr2(i), InStr(1, rawNameArr2(i), "&") - 2)
    Else
        cleanName = rawNameArr2(i)
    End If
    
    If Not IsInArray(rawNameArr2(i), uniNameArr) Then

        ReDim Preserve uniNameArr(uniPos)
        uniNameArr(uniPos) = cleanName
        uniPos = uniPos + 1
        
    End If

Next i

'resize arrays
ReDim t1c1(UBound(uniNameArr))
ReDim t1c2(UBound(uniNameArr))
ReDim t2c1(UBound(uniNameArr))
ReDim t2c2(UBound(uniNameArr))

ReDim showCArr(UBound(uniNameArr))
ReDim showEArr(UBound(uniNameArr))
ReDim showKArr(UBound(uniNameArr))
ReDim showMArr(UBound(uniNameArr))

'store client names for table
rawClientArr1 = Application.Transpose(ws1.Range("A2:A" & lr1).Value)
rawClientArr2 = Application.Transpose(ws2.Range("A2:A" & lr2).Value)

'count each value per requirement for table1
For i = LBound(uniNameArr) To UBound(uniNameArr)

    'file1
    repCount = 0
    ReDim tempArr(0)
    
    showC = ""
    showE = ""
    showK = ""
    showM = ""

    For j = LBound(rawNameArr1) To UBound(rawNameArr1)
    
        If uniNameArr(i) = rawNameArr1(j) Then
        
            repCount = repCount + 1
            showE = showE & "C" & j + 1 & ","
        
            If tempArr(0) = "" Then
            
                tempArr(0) = rawClientArr1(j)
                tempPos = 1
                showC = showC & "A" & j + 1 & ","
                
            Else
            
                If Not IsInArray(rawClientArr1(j), tempArr) Then
            
                    ReDim Preserve tempArr(tempPos)
                    tempArr(tempPos) = rawClientArr1(j)
                    tempPos = tempPos + 1
                    showC = showC & "A" & j + 1 & ","
                    
                End If
            
            End If
        
        End If
    
    Next j
    
    'store count in array
    If repCount > 0 Then t1c2(i) = repCount
    If tempArr(0) <> "" Then t1c1(i) = UBound(tempArr) + 1
    If showE <> "" Then showEArr(i) = Left(showE, Len(showE) - 1)
    If showC <> "" Then showCArr(i) = Left(showC, Len(showC) - 1)
    
    'file2
    repCount = 0
    ReDim tempArr(0)

    For j = LBound(rawNameArr2) To UBound(rawNameArr2)
    
        If uniNameArr(i) = rawNameArr2(j) Then
        
            repCount = repCount + 1
            showM = showM & "C" & j + 1 & ","
        
            If tempArr(0) = "" Then

                tempArr(0) = rawClientArr2(j)
                tempPos = 1
                showK = showK & "A" & j + 1 & ","
                
            Else
            
                If Not IsInArray(rawClientArr2(j), tempArr) Then
            
                    ReDim Preserve tempArr(tempPos)
                    tempArr(tempPos) = rawClientArr2(j)
                    tempPos = tempPos + 1
                    showK = showK & "A" & j + 1 & ","
                    
                End If
            
            End If
        
        End If
    
    Next j
    
    If repCount > 0 Then t2c2(i) = repCount
    If tempArr(0) <> "" Then t2c1(i) = UBound(tempArr) + 1
    If showM <> "" Then showMArr(i) = Left(showM, Len(showM) - 1)
    If showK <> "" Then showKArr(i) = Left(showK, Len(showK) - 1)

Next i

'Place values into table
ws.Range("A3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(uniNameArr)
ws.Range("I3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(uniNameArr)
newlr = ws.Range("A3000").End(xlUp).Row
ws.Range("A" & newlr + 1 & ":A2999").EntireRow.Delete
ws.Range("B3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(t1c1)
ws.Range("D3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(t1c2)
ws.Range("J3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(t2c1)
ws.Range("L3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(t2c2)

ws.Range("F3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(showCArr)
ws.Range("G3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(showEArr)
ws.Range("N3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(showKArr)
ws.Range("O3").Resize(UBound(uniNameArr) + 1, 1) = Application.Transpose(showMArr)

ws.Range("A3:G" & newlr).Sort key1:=ws.Range("A3"), order1:=xlAscending, Header:=xlNo
ws.Range("I3:O" & newlr).Sort key1:=ws.Range("I3"), order1:=xlAscending, Header:=xlNo

stemp.Visible = xlSheetVeryHidden
Application.ScreenUpdating = True

MsgBox Prompt:="Macro Complete", Title:="Done"

ws.Activate

Application.EnableEvents = True

End Sub

Sub getFile1() 'macro to get full name of File 1

Dim mystr As String

With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
    .Title = "Select File 1"
    If .Show = -1 Then
        mystr = .SelectedItems.Item(1)
    Else
        MsgBox Prompt:="Cancelled", Title:="Selection Cancelled"
        Exit Sub
    End If
End With

sctrl.Range("file1").Value = mystr

End Sub

Sub getFile2() 'macro to get full name of File 2

Dim mystr As String

With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
    .Title = "Select File 2"
    If .Show = -1 Then
        mystr = .SelectedItems.Item(1)
    Else
        MsgBox Prompt:="Cancelled", Title:="Selection Cancelled"
        Exit Sub
    End If
End With

sctrl.Range("file2").Value = mystr

End Sub

Private Function getFileName(xStr As String) As String 'Function to get just the file name

Dim slashCount As Byte
Dim startPos As Integer
Dim newStr As String

slashCount = Len(xStr) - Len(Replace(xStr, "\", ""))
xStr = WorksheetFunction.Substitute(xStr, "\", "™", slashCount)
startPos = WorksheetFunction.Search("™", xStr)
xStr = Mid(xStr, startPos + 1, 300)
xStr = WorksheetFunction.Substitute(xStr, ".xl", "™")
xStr = Left(xStr, InStr(1, xStr, "™") - 1)

getFileName = xStr

xStr = Replace(Replace(Replace(Replace(Replace(Replace(Replace(xStr, "/", " "), "\", " "), "*", " "), "[", " "), "]", " "), ":", " "), "?", " ")

End Function

Private Function countPlelimSheets() As Integer

Dim i As Integer, xCount As Integer

For i = 1 To ThisWorkbook.Sheets.Count

    If InStr(1, ThisWorkbook.Sheets(i).Name, "PLELIM") > 0 Then
    
        xCount = xCount + 1
    
    End If

Next i

countPlelimSheets = xCount + 1

End Function

Public Function IsInArray(stringToBeFound As Variant, arr As Variant) As Boolean

Dim i As Integer

For i = LBound(arr) To UBound(arr)
    If arr(i) = stringToBeFound Then
        IsInArray = True
        Exit Function
    End If
Next i

IsInArray = False

End Function

Private Function countInArray(xVal As Variant, xArr As Variant) As Integer

Dim j As Long

For j = LBound(xArr) To UBound(xArr)

    If xArr(j) = xVal Then
        countInArray = countInArray + 1
    End If

Next j

End Function

Private Function ifSheetExists(xName As String) As Boolean

Dim wb As Workbook
Dim i As Integer

Set wb = ThisWorkbook

For i = 1 To wb.Sheets.Count

    If wb.Sheets(i).Name = xName Then
    
        ifSheetExists = True
        GoTo endf
    
    End If

Next i

ifSheetExists = False

endf:
End Function

Sub highlightRange(xSheet As String, xRange As String)

Application.EnableEvents = False

ThisWorkbook.Sheets(xSheet).Activate
ThisWorkbook.Sheets(xSheet).Range(xRange).EntireRow.Style = "Bad"
ThisWorkbook.Sheets(xSheet).Range(xRange).Activate

Application.EnableEvents = True

End Sub

Sub removehighlight(xSheet As String, xRange As String)

With ThisWorkbook.Sheets(xSheet).Range(xRange).EntireRow

    .Interior.Pattern = xlNone
    .Interior.TintAndShade = 0
    .Interior.PatternTintAndShade = 0

    .Font.ColorIndex = xlAutomatic
    .Font.TintAndShade = 0
    
End With

End Sub

Sub returnToSheet()

ThisWorkbook.Sheets(sctrl.Range("lastHome").Value).Activate

End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,406
Office Version
  1. 365
Platform
  1. Windows
Step through the code & see if it populates the array.
 

joishe

New Member
Joined
Mar 3, 2021
Messages
4
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

thanks.
i had many hours of work put in to find my problem. to make things worse, the person who wrote the program swore it worked on his computer.
in the end, the real problem was that i was using a 32 bit version of excel and he was using a 64 bit. who would think that this would mess up different variables and other stuff.
i am writing this, so people should be aware of this problem
 
Solution

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,406
Office Version
  1. 365
Platform
  1. Windows
Glad you sorted it & thanks for the feedback, although I cannot see anything in the posted code that would be affected by 32/64 bit systems.
 

joishe

New Member
Joined
Mar 3, 2021
Messages
4
Office Version
  1. 2016
Platform
  1. Windows
well, I am not an expert, but in front of my eyes, the programmer showed me how the arrays were not available to be held by 32 bit. maybe because my sheets with I uploaded to this macro were quite big. Also he mention something about holding 640+? (because i have a function that highlights all the rows corresponding with certain chosen data.)
 

Watch MrExcel Video

Forum statistics

Threads
1,129,283
Messages
5,635,299
Members
416,851
Latest member
zeldadav

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top