I have the following code and it gives me the error Type mismatch for the line of code «Split_dt_2 = Split(Split_dt_1, ",")». I'm not able to run through the code with F8 because it gives me the error right away so i can't give the exact value of «Split_dt_1» but it's always a date which has that form : [11/1/2019,12/1/2019].
My goal would be to obtain :
y_Dest = 2019 and m_Des = 11
Sub import_Redeem_Spread()
Workbooks.Open "C:\Users\106400\OneDrive\Documents\FTT\CDOPT_AB.xlsm"
Dim wksSource As Worksheet, wksDest As Worksheet
Set wksSource = Workbooks("CDOPT_AB.xlsm").Sheets(2)
Set wksDest = ThisWorkbook.Sheets(2)
Dim Split_dt_1() As String
Dim Split_dt_2() As String
Dim Split_dt_3() As String
Dim Split_dt_4() As String
nbRows = wksSource.Cells(Rows.Count, 1).End(xlUp).Row
nbDates = wksDest.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To nbRows
If wksSource.Cells(i, 16) = "CPG Taux Fixe" Then
For m = 7 To nbDates
Split_dt_1 = wksDest.Cells(m, 2)
Split_dt_2 = Split(Split_dt_1, ",")
Split_dt_3 = Split_dt_2(0)
Split_dt_4 = Split(Split_dt_3, "[")
y_Dest = Right(Split_dt_4(1), 4)
m_Dest = Left(Split_dt_4(1), 2)
y_source = Left(Cells(I, 3), 4)
m_Source = Right(Cells(I, 3), 2)
If y_Dest = m_Dest & y_Source = m_Source Then
For n = 4 To 15
wksDest.Cells(m, n) = wksSource.Cells(i, n)
Next n
End If
Next m
End If
Next i
End Sub
I tried «Dim Split_dt_2() As Variant» but it does noes solve the problem
and I tried
Split_dt_1 = wksDest.Cells(m, 2).value
Split_dt_2 = Split(Split_dt_1, ",")
and it still doesn't work
Thanks in advance!
Use a Variant when using Split to create the array instead of Diming it as a String array.
A Variant will take on the properties of an Array when the function you are using returns an Array.
Dim Split_dt_1 As Variant
Split_dt_1 = Split(wksDest.Cells(m, 2), ",")
I would ditch assigning the Arrays and all the intermediate steps altogether:
y_Dest = Year(Split(Split(wksDest.Cells(m, 2), ",")(0), "[")(0))
There are times when having those intermediate steps helps, but IMO, this isn't one of them.
Related
I'm sure this is something obvious but I haven't gotten it yet. Here is my code:
Sub Grossbypercent()
Dim GrossWeight As Double
Dim i As Long
Dim Val As Long
Dim div(2 To 250) As Variant
Dim x As Long
GrossWeight = Application.WorksheetFunction.Sum(Range("H2:H250"))
For x = 2 To 250
Worksheets("Sheet2").Range("B2:B250") = Application.WorksheetFunction.SumIf(Range("Sheet2!A$2:A$250"), Cells(x, 9), Range("H$2:H$250"))
Next x
For i = 2 To 250
Val = Worksheets("Sheet2").Cells(i, 2)
div(i) = Evaluate(Val & "/" & GrossWeight)
Worksheets("Sheet2").Cells(i, 3) = div(i) * Range("O2").Value
On Error Resume Next
Next i
End Sub
I get the titled error on the Evaluate line, before which the code works fine and outputs as requested. I'm going to warrant a guess that I'm declaring something incorrectly, but I'm not sure what, any guidance would be appreciated.
Dim txt As String
Dim i As Integer
Dim reference As Variant
Dim d As Integer
d = Worksheets("Sheet1").cells(Rows.Count, "a").End(xlUp).Row
txt = cells(3, 4).Value
reference = Split(txt, " ")
For i = 0 To UBound(reference)
cells(d + 1, [4]).Value = reference(i)
Next
txt = cells(3, 4).Value
reference = Split(txt, " ")
cells(d + 1, [12]).Value = reference(3)
Hi, im trying to pick the reference before the ubound value each time, and the copy to the reference to the last line. I got this code to work when its the 4th part of the string but im trying to always pick the value before the ubound. Is it possible to do UBOUND -1. or do i have to go another way around this. thanks max
There are basically 2 ways to pick the prelast value.
Option 1 - Using Ubound():
Sub TestMe()
Dim reference As String
reference = "Stack Overflow is my favourite VBA site!"
Dim splitted As Variant
splitted = Split(reference)
Debug.Print splitted(UBound(splitted) - 1)
End Sub
Option 2 - Using predefined function for array length and removing 2 from it:
Calling it this way:
Debug.Print splitted(GetArrayLength(splitted) - 2)
The function:
Private Function GetArrayLength(myArray As Variant) As Long
If IsEmpty(myArray) Then
GetArrayLength = 0
Else
GetArrayLength = UBound(myArray) - LBound(myArray) + 1
End If
End Function
The function is a bit better, because it checks for empty arrays.
I have a workbook where I want to find the differences of two sheets by looking at the company name and their corporate registration number and then type the differences on the third sheet.
I have tried the code in another workbook with only 143 rows, which works perfectly, but when I try it on the real workbook with 10,000 rows I get a "type mismatch error". Also if I use other columns than the CVR and Firm columns the code also works.
The CVR is numbers and Firms are strings (firm names). I get the
type mismatch error
on the line I marked **. Does somebody know why I get this error?
Sub ComCVR()
Dim CVR1()
Dim CVR2()
Dim Firm1()
Dim Firm2()
Dim n As Long, m As Long
Dim i As Double, j As Double
Dim intCurRow1 As Integer, intCurRow2 As Integer
Dim rng As Range, rng1 As Range
Set rng = ThisWorkbook.Sheets("Last month").Range("A11")
Set rng1 = ThisWorkbook.Sheets("Current month").Range("A11")
n = rng.CurrentRegion.Rows.Count
m = rng1.CurrentRegion.Rows.Count
ReDim CVR1(n)
ReDim Firm1(n)
ReDim CVR2(m)
ReDim Firm2(m)
ThisWorkbook.Sheets("CVR").Range("A1") = "Flyttet CVR"
ThisWorkbook.Sheets("CVR").Range("B1") = "Flyttet Firmanavn"
ThisWorkbook.Sheets("CVR").Range("A1:B1").Interior.ColorIndex = 3
ThisWorkbook.Sheets("CVR").Range("C1") = "Nye CVR"
ThisWorkbook.Sheets("CVR").Range("D1") = "Nye Firmanavn"
ThisWorkbook.Sheets("CVR").Range("C1:D1").Interior.ColorIndex = 4
ThisWorkbook.Sheets("CVR").Range("A1:D1").Font.Bold = True
' Inset data to arrays
For i = 0 To n
CVR1(i) = ThisWorkbook.Sheets("Last month").Cells(12 + i, 5)
Firm1(i) = ThisWorkbook.Sheets("Last month").Cells(12 + i, 4)
Next
For i = 0 To m
CVR2(i) = ThisWorkbook.Sheets("Current month").Cells(12 + i, 5)
Firm2(i) = ThisWorkbook.Sheets("Current month").Cells(12 + i, 4)
Next
intCurRow1 = 2
intCurRow2 = 2
'Old
For i = 0 To n
For j = 0 To m
If Firm1(i) = ThisWorkbook.Sheets("Current month").Cells(12 + j, 4) Then '** Error raised here
Exit For
End If
If j = m Then
ThisWorkbook.Sheets("CVR").Cells(intCurRow1, 1) = CVR1(i)
ThisWorkbook.Sheets("CVR").Cells(intCurRow1, 2) = Firm1(i)
intCurRow1 = intCurRow1 + 1
End If
Next j
Next i
'new
For i = 0 To m
For j = 0 To n
If Firm2(i) = ThisWorkbook.Sheets("Last month").Cells(12 + j, 4) Then
Exit For
End If
If j = n Then
ThisWorkbook.Sheets("CVR").Cells(intCurRow2, 3) = CVR2(i)
ThisWorkbook.Sheets("CVR").Cells(intCurRow2, 4) = Firm2(i)
intCurRow2 = intCurRow2 + 1
End If
Next j
Next i
Columns("A:B").Select
ActiveSheet.Range("$A:$B").RemoveDuplicates Columns:=1, Header:=xlNo
Application.DisplayAlerts = False
Columns("C:D").Select
ActiveSheet.Range("$C:$D").RemoveDuplicates Columns:=1, Header:=xlNo
Application.DisplayAlerts = False
End Sub
Whenever an error happens, the best way is to google it. This is what it says in the documentation of VBA for Type mismatch:
Cause: The variable or property isn't of the correct type. For example, a variable that requires an integer value can't accept a string value unless the whole string can be recognized as an integer.
In the case of the code, it happens, when an array is compared with excel cell. Now the trick - in order to see why it happens, see what is in these:
Debug.Print ThisWorkbook.Sheets("Last month").Cells(12 + i, 4)
Debug.Print Firm1(i)
and the after the error runs, take a look at the immediate window (Ctrl+G). It it quite possible, that there is an error in the excel cell, thus it cannot be compared. This is some easy way to avoid it, if this is the case:
Sub TestMe()
Dim myRange As Range
Set myRange = Worksheets(1).Cells(1, 1)
myRange.Formula = "=0/0"
If Not IsError(myRange) Then
Debug.Print CBool(myRange = 2)
Else
Debug.Print myRange.Address; " is error!"
End If
End Sub
I need a bit of help with a small project. I just started VBA and I think I could use learning to optimise my code.
Cell A2, contains a text with many email address separated by ",". I managed to extract all the email addresses but I think I made too much use of cells, and I was wondering if you can help me reduce that and use the variables defined instead.
Screenshot of the working code
Sub fpor()
Dim Text As String
Dim full As Integer
Dim i As Integer
Dim e As Integer
Dim part As String
Dim part_len As Integer
Dim part_a As Integer
Dim Text_2 As String
x = 5
ActiveCell = Range("A2")
Text = Range("A2")
full = Len(Text)
'full = InStrRev(Text, ",")
For i = 1 To full
Cells((x + i), 1).Value = Text
part = InStr(Text, ",")
Cells((x + i), 2).Value = part
Cells((x + i), 3) = Left(Text, part)
Cells((x + i), 4) = full - part
Text = Right(Cells((x + i), 1), Cells((x + i), 4))
If part = 0 Then
full = 0
Cells((x + i), 3) = Text
Exit For
Else:
full = Len(Text)
End If
Next i
MsgBox (full)
MsgBox (part)
End Sub `
How do you think I can better optimise the For Loop?
Thank you all for your answers you awesome people : )
you can greatly simplify your code with the use of Split() Function as follows:
Option Explicit
Sub fpor()
Dim emailsArr As Variant
With Worksheets("emails") '<--change "emails" with your actual sheet name
emailsArr = Split(.Range("a2"), ",") '<--| split all emails names delimited by a ',' into an array
.Range("A6").Resize(UBound(emailsArr)).value = Application.Transpose(emailsArr) '<--| write array content from cell A6 downwards
End With
End Sub
I have Dictionary objects Dic1,Dic2, whose Items are an alphabet. Say
Dic1(10)= A
Dic1(111)= B
Dic1(12)= C like this.
Dic2(125)= A
Dic2(131)= B
Dic2(126)= C like this.
Now I am trying to assign their keys through a loop in Excel row(3rd column onwards) by below,but not all keys are getting copied.
objSheet2.Range("C"&nRow).Value=Dic1.Keys() Or(condition wise any of the assignment
will be executed)
objSheet2.Range("C"&nRow).Value=Dic2.Keys()
But only the first Key value is getting copied,ignoring the other. Can you tell what the Bug is in my code?
Edit
Option Explicit
Class cP
Public m_sRel
Public m_dicC
Private Sub Class_Initialize()
m_sRel = "Child"
Set m_dicC = CreateObject("Scripting.Dictionary")
End Sub
Public Function show()
show = m_sRel & " " & Join(m_dicC.Keys)
End Function
End Class
Dim objSheet1,objSheet2,TotalRows,TotalcolCopy,strPathExcel1
'Dim oFS : Set oFS = CreateObject("Scripting.FileSystemObject")
Dim oXls : Set oXls = CreateObject("Excel.Application")
'Dim aData ': aData = oWb.Worksheets(1).Range("$A2:$C10")
Dim dicP : Set dicP = CreateObject("Scripting.Dictionary")
Dim nRow,nP,sKeys
strPathExcel1 = "D:\WIPData\AravoMacro\Finalscripts\A.xlsx"
oXls.Workbooks.open strPathExcel1
'oXls.Workbooks.Open(oFs.GetAbsolutePathName("A.xlsx"))
Set objSheet1 = oXls.ActiveWorkbook.Worksheets("WingToWingMay25")
Set objSheet2 = oXls.ActiveWorkbook.Worksheets("ParentChildLink")
TotalRows=oXls.Application.WorksheetFunction.CountA(objSheet1.Columns(1))
TotalcolCopy=oXls.Application.WorksheetFunction.Match("Parent Business Process ID", objSheet1.Rows(3), 0)
objSheet1.Range(objSheet1.Cells(4,1),objSheet1.Cells(TotalRows,TotalcolCopy)).Copy(objSheet2.Range("A1"))
objSheet2.Range(objSheet2.Cells(1,2),objSheet2.Cells(TotalRows,TotalcolCopy-1)).Delete(-4159)
'Dim aData : aData=objSheet2.Cells.SpecialCells(12)'xlCellTypeVisible
Dim aData : aData = objSheet2.Range("A1:B"&TotalRows-3)
'MsgBox(LBound(aData, 1)&"And"&UBound(aData, 1))
For nRow = LBound(aData, 1) To UBound(aData, 1)
Set dicP(aData(nRow, 1)) = New cP
'Set dicP(aData(nRow, 2)) = New cP
Next
'objSheet2.Cells.ClearContents'To clear all the previous contenets of the sheet#2
'sKeys=dicP.Keys
'objSheet2.Range("A1").Resize(dicP.Count) = oXls.Application.Transpose(sKeys)
'MsgBox(dicP.Count&":"&UBound(aData, 1)&":"&LBound(aData, 1))
For nRow = LBound(aData, 1) To UBound(aData, 1)
If aData(nRow, 1) = aData(nRow, 2) Then
dicP(aData(nRow, 1)).m_sRel = "Parent"
Else
If dicP.Exists(aData(nRow, 2)) Then
dicP(aData(nRow, 2)).m_dicC.Add aData(nRow, 1), 0 '(aData(nRow, 1)) = 0
End If
End If
Next
objSheet2.Cells.ClearContents'To clear all the previous contenets of the sheet#2
nRow=1
For Each nP In dicP.Keys()
objSheet2.Cells(nRow,1).Value=nP
objSheet2.Cells(nRow,2).Value=dicP(nP).m_sRel
objSheet2.Range("C"&nRow).Resize(1+ UBound(dicP(nP).m_dicC.Keys()) + 1).Value=dicP(nP).m_dicC.Keys()
'Range("C" & nRow).Resize(1, UBound(d.Keys()) + 1).Value = d.Keys()
nRow=nRow+1
Next
I am getting an error as Unknown Run time error at the line objSheet2.Range("C"&nRow).Resize(1+ UBound(dicP(nP).m_dicC.Keys()) + 1).Value=dicP(nP).m_dicC.Keys()
Thanks,
Yes, you assign an array only to one cell. Then only the first value is copied in.
You have to assign the array to a range of the right size. This can be done with Range.Resize.
Then again, Excel treats the array as a 2-dimensional array (a matrix), and if it is only one-dimensional, this will always be the seen as the first row. If you copy this into a vertical range, each cell will have the same first element of your array.
For a vertical range, you have to transpose your array/virtual matrix:
Sub test()
Dim d
Dim nRow As Long
nRow = 3
Set d = CreateObject("Scripting.Dictionary")
d(1) = "A"
d(2) = "B"
d(17) = "C"
d(32) = "F"
' horizontal:
Range("C" & nRow).Resize(1, UBound(d.Keys()) + 1).Value = d.Keys()
' vertical insert needs the data transformed
Range("C" & nRow).Resize(UBound(d.Keys()) + 1).Value = WorksheetFunction.Transpose(d.Keys())
End Sub
For your edit, you may first of all need to correct ("C"&nRow) to ("C" & nRow). The spaces are required.
Another error is Resize(1 + ... + 1), so you add +2, but this should not throw an error.